Reduce The Lengthly Code In Firemonkey

Reduce The Lengthly Code In Firemonkey - firemonkey

I have many layouts in my Firemonkey APP, and all the TVertscrollBox share the same DoCalcContentsBounds, DoRestorePosition, DoUpdateKBBounds as below, I want to reduce it and keep the same functionality, how can I do?
procedure TBTCXCHGForm.BTCXCHGDoRestorePosition;
begin
if BTCXCHGAddSalesVertScrollBox.Visible then
begin
with BTCXCHGAddSalesVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGEnterSellerDetailVertScrollBox.Visible then
begin
with BTCXCHGEnterSellerDetailVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGEnterBuyBTCDetailVertScrollBox.Visible then
begin
with BTCXCHGEnterBuyBTCDetailVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGAddBuyVertScrollBox.Visible then
begin
with BTCXCHGAddBuyVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGChangeSalesConfirmationVertScrollBox.Visible then
begin
with BTCXCHGChangeSalesConfirmationVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGEnterSellBTCDetailVertScrollBox.Visible then
begin
with BTCXCHGEnterSellBTCDetailVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGMinerPurchaseVertScrollBox.Visible then
begin
with BTCXCHGMinerPurchaseVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGReceiveBitcoinsVertScrollBox.Visible then
begin
with BTCXCHGReceiveBitcoinsVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGSendBitcoinsVertScrollBox.Visible then
begin
with BTCXCHGSendBitcoinsVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGUserRegistrationVertScrollBox.Visible then
begin
with BTCXCHGUserRegistrationVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGChangeSecurityPasswordVertScrollBox.Visible then
begin
with BTCXCHGChangeSecurityPasswordVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGChangeUserPasswordVertScrollBox.Visible then
begin
with BTCXCHGChangeUserPasswordVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGLoginRegisterSelectionUserEmailVerificationVertScrollBox.Visible then
begin
with BTCXCHGLoginRegisterSelectionUserEmailVerificationVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGLoginRegisterSelectionUserForgetPasswordVertScrollBox.Visible then
begin
with BTCXCHGLoginRegisterSelectionUserForgetPasswordVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGLoginRegisterSelectionUserLoginVertScrollBox.Visible then
begin
with BTCXCHGLoginRegisterSelectionUserLoginVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end
else
begin
if BTCXCHGLoginRegisterSelectionRegistrationVertScrollBox.Visible then
begin
with BTCXCHGLoginRegisterSelectionRegistrationVertScrollBox do
ViewportPosition := PointF(ViewportPosition.X, 0);
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
procedure TBTCXCHGForm.BTCXCHGDoUpdateKBBounds;
var
LFocused: TControl;
LFocusRect: TRectF;
begin
if BTCXCHGAddSalesVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGAddSalesVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGAddSalesLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGAddSalesVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGEnterSellerDetailVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGEnterSellerDetailVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGEnterSellerDetailLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGEnterSellerDetailVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGEnterBuyBTCDetailVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGEnterBuyBTCDetailVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGEnterBuyBTCDetailLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGEnterBuyBTCDetailVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGAddBuyVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGAddBuyVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGAddBuyLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGAddBuyVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGChangeSalesConfirmationVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGChangeSalesConfirmationVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGChangeSalesConfirmationLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGChangeSalesConfirmationVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGEnterSellBTCDetailVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGEnterSellBTCDetailVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGEnterSellBTCDetailLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGEnterSellBTCDetailVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGMinerPurchaseVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGMinerPurchaseVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGMinerPurchaseLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGMinerPurchaseVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGReceiveBitcoinsVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGReceiveBitcoinsVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGReceiveBitcoinsLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGReceiveBitcoinsVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGSendBitcoinsVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGSendBitcoinsVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGSendBitcoinsLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGSendBitcoinsVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGUserRegistrationVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGUserRegistrationVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGUserRegistrationLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGUserRegistrationVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGChangeSecurityPasswordVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGChangeSecurityPasswordVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGChangeSecurityPasswordLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGChangeSecurityPasswordVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGChangeUserPasswordVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGChangeUserPasswordVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGChangeUserPasswordLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGChangeUserPasswordVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGLoginRegisterSelectionUserEmailVerificationVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGLoginRegisterSelectionUserEmailVerificationVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGLoginRegisterSelectionUserEmailVerificationLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGLoginRegisterSelectionUserEmailVerificationVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGLoginRegisterSelectionUserForgetPasswordVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGLoginRegisterSelectionUserForgetPasswordVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGLoginRegisterSelectionUserForgetPasswordLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGLoginRegisterSelectionUserForgetPasswordVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGLoginRegisterSelectionUserLoginVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGLoginRegisterSelectionUserLoginVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGLoginRegisterSelectionUserLoginLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGLoginRegisterSelectionUserLoginVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end
else
begin
if BTCXCHGLoginRegisterSelectionRegistrationVertScrollBox.Visible then
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(BTCXCHGLoginRegisterSelectionRegistrationVertScrollBox.ViewportPosition);
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGLoginRegisterSelectionRegistrationLayout.Align := TAlignLayout.Horizontal;
with BTCXCHGLoginRegisterSelectionRegistrationVertScrollBox do
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;

Declare a field in TBTCXCHGForm to hold a reference to currently visible VertScrollBox. Whenever the visible VertScrollBox is changed, assign the scroll box to this field. For example:
CurrentlyVisibleVertScrollBox: TVertscrollBox;
Then your BTCXCHGDoRestorePosition procedure can be reduced to
procedure TBTCXCHGForm.BTCXCHGDoRestorePosition;
begin
with CurrentlyVisibleVertScrollBox do // <----
ViewportPosition := PointF(ViewportPosition.X, 0);
end;
and the BTCXCHGDoUpdateKBBounds can be reduced to
procedure TBTCXCHGForm.BTCXCHGDoUpdateKBBounds;
var
LFocused: TControl;
LFocusRect: TRectF;
begin
BTCXCHGNeedOffset := False;
if Assigned(Focused) then
begin
LFocused := TControl(Focused.GetObject);
LFocusRect := LFocused.AbsoluteRect;
LFocusRect.Offset(CurrentlyVisibleVertScrollBox.ViewportPosition); // <----
if (LFocusRect.IntersectsWith(TRectF.Create(BTCXCHGKBBounds))) and (LFocusRect.Bottom > BTCXCHGKBBounds.Top) then
begin
BTCXCHGNeedOffset := True;
BTCXCHGAddSalesLayout.Align := TAlignLayout.Horizontal;
with CurrentlyVisibleVertScrollBox do // <----
begin
RealignContent;
Application.ProcessMessages;
ViewportPosition := PointF(ViewportPosition.X, LFocusRect.Bottom - BTCXCHGKBBounds.Top);
end;
end;
end;
if not BTCXCHGNeedOffset then
BTCXCHGDoRestorePosition;
end;
The modified lines are marked ( // <----).
You did not post the third procedure, DoCalcContentsBounds, but if it follows a similar pattern, it should be obvious how to modify it.

Related

search in multilevel linked lists in Pascal

So in this program we are asked to create a database for a university, the university is divided into faculties and each faculty is divided into departments, similarly, each department is divided into courses (specialities) and each course is divided into grades, and each grade has a list of students. I implemented this using linked lists, after the user fills the database, they get some options to interact with the database such as adding and removing students, etc. But, when I try to search for a student in the database it seems not to search well although the method works well when searching for a course (it gives in which faculty the course is and in which department). When the program is executed it gives us the message ("name" doesn't exist in this database) which indicates that cmp is still set to 0.
Program Liked_lists_database;
Type
Node = ^T;
T = record
age : string;
next, link : Node;
end;
Var
Head, Tail, Last, tmp, tmp2, tmp3, tmp4, tmp5 : Node;
y : string;
cmp : integer;
Begin
writeln('[+] Create your database [+]');
writeln;
Repeat
write('Enter the name of the faculty : ');
readln(j);
if (j='exit') then break;
if (Head = nil) then
Begin
new(Head);
Tail := Head;
End
Else
Begin
new(Tail^.next);
Tail := Tail^.next;
End;
Tail^.age := j;
Tail^.next := nil;
Repeat
Write('Enter the name of the department : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link=Nil) Then
Begin
new(Tail^.link);
Last := Tail^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Repeat
Write('Enter the name of the course : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link^.link=Nil) Then
Begin
new(Tail^.link^.link);
Last := Tail^.link^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Repeat
Write('Enter the grade : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link^.link^.link=Nil) Then
Begin
new(Tail^.link^.link^.link);
Last := Tail^.link^.link^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Repeat
Write('Enter the name of the student : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link^.link^.link^.link=Nil) Then
Begin
new(Tail^.link^.link^.link^.link);
Last := Tail^.link^.link^.link^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Until false;
Until false;
Until false;
Until false;
Until false;
writeln;
writeln('...The database has been created successfully!');
// Search for a student
writeln('[+] Search for a student');
write('Enter the name of the student to Search for : ');
readln(y);
tmp := Head;
cmp := 0;
if (cmp=0) then
While (tmp^.next<>Nil) Do
Begin
tmp2 := tmp^.link;
While (tmp2^.next<>Nil) Do
Begin
tmp3 := tmp2^.link;
While (tmp3^.next<>Nil) Do
Begin
tmp4 := tmp3^.link;
While (tmp4^.next<>Nil) Do
Begin
tmp5 := tmp4^.link;
While (tmp5^.next<>Nil) Do
Begin
if (tmp5^.age=y) then
cmp := cmp + 1;
tmp5 := tmp5^.next;
End;
if (cmp>0) then
tmp4^.next := Nil
Else
tmp4 := tmp4^.next;
End;
if (cmp>0) then
tmp3^.next := Nil
Else
tmp3 := tmp3^.next;
End;
if (cmp>0) then
tmp2^.next := Nil
Else
tmp2 := tmp2^.next;
End;
if (cmp>0) then
tmp^.next := Nil
Else
tmp := tmp^.next;
End;
if (cmp>0) then
Begin
writeln('Name : ',y);
writeln('Faculty : ', tmp^.age);
writeln('Department : ', tmp2^.age);
writeln('Speciality : ', tmp3^.age);
writeln('Grade : ', tmp4^.age);
End
Else
writeln(y, ' does not exist in this database');
End.
EDIT : the problem was with the implementation of the multilevel linked list and the searching algorithm
Program Liked_lists_database;
Type
Node = ^T;
T = record
age : string;
next, link : Node;
end;
Var
Head, Tail, tmp, Last : Node;
j: string;
num : integer;
Procedure searchCourse;
Var
cmp : integer;
y : string;
tmp, tmp2, tmp3 : Node;
Begin
writeln('[+] Search for a course');
write('Enter the name of the course to Search for : ');
readln(y);
tmp := Head;
cmp := 0;
if (tmp^.next=Nil) Then
new(tmp^.next);
While (tmp^.next<>Nil) Do
Begin
tmp2 := tmp^.link;
if (tmp2^.next=Nil) Then
new(tmp2^.next);
While (tmp2^.next<>Nil) Do
Begin
tmp3 := tmp2^.link;
While (tmp3<>Nil) Do
Begin
if (tmp3^.age=y) Then
Begin
writeln('[', y, '] is found in faculty of [ ', tmp^.age, ']', ' department of [', tmp2^.age, ']');
cmp := 1;
End;
tmp3 := tmp3^.next;
End;
if (cmp=0) Then
Begin
tmp2 := tmp2^.next;
if (tmp2^.next=Nil) Then
new(tmp2^.next);
End
Else
tmp2^.next := Nil;
End;
if (cmp=0) Then
Begin
tmp := tmp^.next;
if (tmp^.next=Nil) Then
new(tmp^.next);
End
Else
tmp^.next := Nil;
End;
if (cmp=0) Then
writeln ('[', y, '] : there is no such course');
End;
Begin
// Fillin in the database
writeln('[+] Create your database [+]');
writeln;
Repeat
write('Enter the name of the faculty : ');
readln(j);
if (j='exit') then break;
if (Head = nil) then
Begin
new(Head);
Tail := Head;
End
Else
Begin
new(Tail^.next);
Tail := Tail^.next;
End;
Tail^.age := j;
Tail^.next := nil;
Repeat
Write('Enter the name of the department : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link=Nil) Then
Begin
new(Tail^.link);
Last := Tail^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Repeat
Write('Enter the name of the course : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link^.link=Nil) Then
Begin
new(Tail^.link^.link);
Last := Tail^.link^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Repeat
Write('Enter the grade : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link^.link^.link=Nil) Then
Begin
new(Tail^.link^.link^.link);
Last := Tail^.link^.link^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Repeat
Write('Enter the name of the student : ');
Readln(j);
if (j='exit') then break;
if (Tail^.link^.link^.link^.link=Nil) Then
Begin
new(Tail^.link^.link^.link^.link);
Last := Tail^.link^.link^.link^.link;
End
Else
Begin
new(Last^.next);
Last := Last^.next;
End;
Last^.age := j;
Last^.next := Nil;
Until false;
Until false;
Until false;
Until false;
Until false;
writeln;
writeln('...The database has been created successfully!');
searchCourse;
Readln;
End.

Monotone chain change data structure to doubly linked list

for (size_t i = 0; i < n; ++i) {
while (k >= 2 && cross(H[k-2], H[k-1], P[i]) <= 0) k--;
H[k++] = P[i];
for (size_t i = n-1, t = k+1; i > 0; --i) {
while (k >= t && cross(H[k-2], H[k-1], P[i-1]) <= 0) k--;
H[k++] = P[i-1];
I found the code for it on wikipedia but for some reasons I prefer to use doubly linked list as data structure The problem is in this first condition for while loop while(k>=2&&...) and while(k>=t && ...)
How can I rewrite these while loops on linked list

unit DoublyLinkedList;
interface
const NULL = NIL;
type TPoint = record
x,y:longint;
end;
PLink = ^TLink;
TLink = record
point:TPoint;
next:PLink;
prev:PLink;
end;
TList = record
first:PLink;
last:PLink;
end;
TFunc = function(A,B:TPoint):integer;
procedure ListInit(var L:TList);
function ListFind(L:TList;key:TPoint):PLink;
function ListIsEmpty(L:TList):boolean;
procedure ListInsertFirst(var L:TList;dd:TPoint);
procedure ListInsertLast(var L:TList;dd:TPoint);
procedure ListDeleteFirst(var L:TList);
procedure ListDeleteLast(var L:TList);
procedure ListInsert(var L:TList;dd:TPoint);
function ListInsertAfter(var L:TList;key,dd:TPoint):boolean;
procedure ListDeleteKey(var L:TList;key:TPoint);
procedure ListDisplayForward(L:TList);
procedure ListDisplayBackward(L:TList);
procedure BSTsort(var L:TList);
implementation
function equals(p1,p2:TPoint):boolean;
begin
equals:=(p1.x = p2.x) and (p1.y = p2.y);
end;
function compare(A,B:TPoint):integer;
var t:integer;
begin
t := 1;
if(A.x < B.x)or((A.x = B.x)and(A.y < B.y))then
t := -1;
if(A.x = B.x)and(A.y = B.y)then
t := 0;
compare := t;
end;
procedure BSTinsert(var root:PLink;x:PLink);
begin
if root = NULL then
begin
root := x;
x^.prev := NULL;
x^.next := NULL;
end
else if compare(root^.point,x^.point) = 0 then
BSTinsert(root^.prev,x)
else if compare(root^.point,x^.point) < 0 then
BSTinsert(root^.next,x)
else
BSTinsert(root^.prev,x);
end;
procedure BSTtoDLL(root:PLink;var L:TList);
begin
if root <> NULL then
begin
BSTtoDLL(root^.prev,L);
if ListIsEmpty(L) then
L.first := root
else
L.last^.next := root;
root^.prev := L.last;
L.last := root;
BSTtoDLL(root^.next,L);
end;
end;
procedure BSTsort(var L:TList);
var root,temp:PLink;
begin
root := NULL; (*This instruction was missing in the code *)
while not ListIsEmpty(L)do
begin
temp := L.first;
if L.first^.next = NULL then
L.last := NULL
else
L.first^.next^.prev := NULL;
L.first := L.first^.next;
BSTinsert(root,temp);
end;
BSTtoDLL(root,L);
end;
procedure ListInit(var L:TList);
begin
L.first := NULL;
L.last := NULL;
end;
function ListFind(L:TList;key:TPoint):PLink;
var p:PLink;
begin
p := L.first;
while(p <> NULL)and(not equals(key,p^.point))do
p := p^.next;
ListFind := p;
end;
function ListIsEmpty(L:TList):boolean;
begin
ListIsEmpty := L.first = NULL;
end;
procedure ListInsertFirst(var L:TList;dd:TPoint);
var newLink:PLink;
begin
new(newLink);
newLink^.point.x := dd.x;
newLink^.point.y := dd.y;
newLink^.next := NULL;
newLink^.prev := NULL;
if ListIsEmpty(L) then
L.last := newLink
else
L.first^.prev := newLink;
newLink^.next := L.first;
L.first := newLink;
end;
procedure ListInsertLast(var L:TList;dd:TPoint);
var newLink:PLink;
begin
new(newLink);
newLink^.point.x := dd.x;
newLink^.point.y := dd.y;
newLink^.next := NULL;
newLink^.prev := NULL;
if ListIsEmpty(L) then
L.first := newLink
else
begin
L.last^.next := newLink;
newLink^.prev := L.last;
end;
L.last := newLink;
end;
procedure ListDeleteFirst(var L:TList);
var temp:PLink;
begin
if not ListIsEmpty(L) then
begin
temp := L.first;
if L.first^.next = NULL then
L.last := NULL
else
L.first^.next^.prev := NULL;
L.first := L.first^.next;
dispose(temp);
end;
end;
procedure ListDeleteLast(var L:TList);
var temp:PLink;
begin
if not ListIsEmpty(L) then
begin
temp := L.last;
if L.first^.next = NULL then
L.first := NULL
else
L.last^.prev^.next := NULL;
L.last := L.last^.prev;
dispose(temp);
end;
end;
procedure ListInsert(var L:TList;dd:TPoint);
var newLink,current:PLink;
begin
new(newLink);
newLink^.point.x := dd.x;
newLink^.point.y := dd.y;
newLink^.next := NULL;
newLink^.prev := NULL;
current := L.first;
while(current <> NULL)and(compare(newLink^.point,current^.point) > 0)do
current := current^.next;
if current = NULL then
begin
if ListIsEmpty(L)then
L.first := newLink
else
begin
L.last^.next := newLink;
newLink^.prev := L.last;
end;
L.last := newLink;
end
else if current^.prev = NULL then
begin
L.first := newLink;
newLink^.next := current;
current^.prev := newLink;
newLink^.prev := NULL;
current := newLink;
end
else
begin
current^.prev^.next := newLink;
newLink^.next := current;
newLink^.prev := current^.prev;
current^.prev := newLink;
end;
end;
function ListInsertAfter(var L:TList;key,dd:TPoint):boolean;
var newLink,current:PLink;
found:boolean;
begin
current := ListFind(L,key);
found := current <> NULL;
if found then
begin
new(newLink);
newLink^.point.x := dd.x;
newLink^.point.y := dd.y;
newLink^.next := NULL;
newLink^.prev := NULL;
if current^.next = NULL then
begin
newLink^.next := NULL;
L.last := newLink;
end
else
begin
newLink^.next := current^.next;
current^.next^.prev := newLink;
end;
newLink^.prev := current;
current^.next := newLink;
end;
ListInsertAfter:= found;
end;
procedure ListDeleteKey(var L:TList;key:TPoint);
var current:PLink;
begin
current := ListFind(L,key);
if current <> NULL then
begin
if current^.prev = NULL then
L.first := current^.next
else
current^.prev^.next := current^.next;
if current^.next = NULL then
L.last := current^.prev
else
current^.next^.prev := current^.prev;
dispose(current);
end;
end;
procedure ListDisplayForward(L:TList);
var current :PLink;
begin
write('List (first-->last): ');
current := L.first;
while current <> NIL do
begin
write('(',current^.point.x,',',current^.point.y,') -> ');
current := current^.next;
end;
writeln('NULL');
end;
procedure ListDisplayBackward(L:TList);
var current :PLink;
begin
write('List (last-->first): ');
current := L.last;
while current <> NIL do
begin
write('(',current^.point.x,',',current^.point.y,') -> ');
current := current^.prev;
end;
writeln('NULL');
end;
begin
end.
program MonotoneChain;
uses crt,doublylinkedlist;
function equals(a,b:TPoint):boolean;
begin
equals := (a.x = b.x) and (a.y = b.y)
end;
function vect(a1,a2,b1,b2:TPoint):longint;
begin
vect := (a2.x - a1.x) * (b2.y - b1.y) - (b2.x - b1.x) * (a2.y - a1.y)
end;
function dist2(a1,a2:TPoint):longint;
begin
dist2 := sqr(a2.x - a1.x) + sqr(a2.y-a1.y)
end;
procedure Solve(var A,B:TList);
var k,t:longint;
pt:PLink;
begin
ListInit(B);
if not ListIsEmpty(A)then
begin
k := 0;
pt := A.first;
while pt <> NULL do
begin
while(k >= 2)and(vect(B.last^.prev^.point,B.last^.point,B.last^.prev^.point,pt^.point) <= 0)do
begin
ListDeleteLast(B);
k := k - 1;
end;
ListInsertLast(B,pt^.point);
k := k + 1;
pt := pt^.next;
end;
t := k + 1;
pt := A.last;
while pt <> NULL do
begin
while(k >= t)and(vect(B.last^.prev^.point,B.last^.point,B.last^.prev^.point,pt^.point) <= 0)do
begin
ListDeleteLast(B);
k := k - 1;
end;
ListInsertLast(B,pt^.point);
k := k + 1;
pt := pt^.prev;
end;
ListDeleteLast(B);
end;
end;
procedure main;
var A,B:TList;
input:text;
p:TPoint;
path:string;
begin
ListInit(A);
writeln('Podaj sciezke do pliku z danymi do wczytania');
readln(path);
path := 'F:\fpc\3.0.4\bin\i386-win32\monotonechain\' + path;
assign(input,path);
{$I-}
reset(input);
{$I+}
if IOResult <> 0 then
writeln('Pliku nie udalo sie wczytac')
else
begin
while not eof(input) do
begin
while not eoln(input) do
begin
read(input,p.x,p.y);
ListInsertLast(A,p);
end;
readln(input);
writeln('List A');
ListDisplayForward(A);
ListDisplayBackward(A);
BSTsort(A);
Solve(A,B);
writeln('List A');
ListDisplayForward(A);
ListDisplayBackward(A);
writeln('List B');
ListDisplayForward(B);
ListDisplayBackward(B);
while not ListIsEmpty(A) do
ListDeleteFirst(A);
while not ListIsEmpty(B) do
ListDeleteFirst(B);
end;
close(input);
end;
readkey;
end;
BEGIN
main;
END.
Here is the code
Segmentation fault appears while I try to sort
the list using BST
Probably when I try to insert the node removed from head of the list to the BST
Segmentation fault appears only when I call it from procedure which finds the convex hull
When I call it from main block of code everything seem to be ok
One of the casese of segmentetion fault is dereferencing null pointer
but i dont know is this segmentation fault caused by dereferencing null pointer
It is strange for me that BSTsort called in main block of code works ok
but BSTsort called in Solve procedure causes segmentation fault
I think i know how to correct this sorting procedure
but I would like to know why segmentation fault occured and why only
in Solve procedure

Export query result to csv in oracle stored procedure

So i have a query that i would like to execute through a stored procedure and export the output of the query to a CSV file. So i am using the following stored procedure to do it:
CREATE OR REPLACE PROCEDURE parseCSV(
p_file_dir VARCHAR2, -- Oracle directory name
p_file_name VARCHAR2, -- filename
p_sql_query VARCHAR2, -- select * from table or some such query
p_delimiter CHAR -- column delimiter
)
AS
l_cursor_handle INTEGER;
l_dummy NUMBER;
l_col_cnt INTEGER;
l_rec_tab DBMS_SQL.DESC_TAB;
l_current_col NUMBER(16);
l_current_line VARCHAR2(2047);
l_column_value VARCHAR2(300);
l_file_handle UTL_FILE.FILE_TYPE;
l_print_text VARCHAR2(100);
l_record_count NUMBER(16) := 0;
BEGIN
l_file_handle := UTL_FILE.FOPEN(p_file_dir, p_file_name, 'a', 2047);
l_cursor_handle := DBMS_SQL.OPEN_CURSOR;
DBMS_SQL.PARSE(l_cursor_handle, p_sql_query, DBMS_SQL.native);
l_dummy := DBMS_SQL.EXECUTE(l_cursor_handle);
DBMS_SQL.DESCRIBE_COLUMNS(l_cursor_handle, l_col_cnt, l_rec_tab);
l_current_col := l_rec_tab.FIRST;
IF (l_current_col IS NOT NULL) THEN
LOOP
DBMS_SQL.DEFINE_COLUMN(l_cursor_handle, l_current_col, l_column_value, 300);
l_print_text := l_rec_tab(l_current_col).col_name || p_delimiter;
UTL_FILE.PUT (l_file_handle, l_print_text);
l_current_col := l_rec_tab.NEXT(l_current_col);
EXIT WHEN (l_current_col IS NULL);
END LOOP;
END IF;
UTL_FILE.PUT_LINE (l_file_handle,' ');
LOOP
EXIT WHEN DBMS_SQL.FETCH_ROWS(l_cursor_handle) = 0;
l_current_line := '';
FOR l_current_col IN 1..l_col_cnt LOOP
DBMS_SQL.COLUMN_VALUE (l_cursor_handle, l_current_col, l_column_value);
l_print_text := l_column_value || p_delimiter;
l_current_line := l_current_line || l_column_value || p_delimiter;
END LOOP;
l_record_count := l_record_count + 1;
UTL_FILE.PUT_LINE (l_file_handle, l_current_line);
END LOOP;
UTL_FILE.FCLOSE (l_file_handle);
DBMS_SQL.CLOSE_CURSOR(l_cursor_handle);
END;
/
The procedure when executed processes the query and then stores the result into a delimited file. For example, the output of the procedure for a regular SELECT statement will be of this form:
ID,ROLL_NO,RANK,
1,123456,1620,
2,987654,1344,
Now herein lies my issue. As you can see each row within the output file is ending with an extra trailing ,. Now, due to my lack of knowledge in plsql, i can't think of a modification that i can do to the procedure so that the expected output file would be of this form:
ID,ROLL_NO,RANK
1,123456,1620
2,987654,1344
Could someone be kind enough to help out an Oracle newbie here and give me some pointers as to how i can do it? I would appreciate it a lot.

Please try the below where comments have been added
CREATE OR REPLACE PROCEDURE parseCSV(
p_file_dir VARCHAR2, -- Oracle directory name
p_file_name VARCHAR2, -- filename
p_sql_query VARCHAR2, -- select * from table or some such query
p_delimiter CHAR -- column delimiter
)
AS
l_cursor_handle INTEGER;
l_dummy NUMBER;
l_col_cnt INTEGER;
l_rec_tab DBMS_SQL.DESC_TAB;
l_current_col NUMBER(16);
l_current_line VARCHAR2(2047);
l_column_value VARCHAR2(300);
l_file_handle UTL_FILE.FILE_TYPE;
l_print_text VARCHAR2(100);
l_record_count NUMBER(16) := 0;
BEGIN
l_file_handle := UTL_FILE.FOPEN(p_file_dir, p_file_name, 'a', 2047);
l_cursor_handle := DBMS_SQL.OPEN_CURSOR;
DBMS_SQL.PARSE(l_cursor_handle, p_sql_query, DBMS_SQL.native);
l_dummy := DBMS_SQL.EXECUTE(l_cursor_handle);
DBMS_SQL.DESCRIBE_COLUMNS(l_cursor_handle, l_col_cnt, l_rec_tab);
l_current_col := l_rec_tab.FIRST;
IF (l_current_col IS NOT NULL) THEN
LOOP
DBMS_SQL.DEFINE_COLUMN(l_cursor_handle, l_current_col, l_column_value, 300);
l_print_text := l_rec_tab(l_current_col).col_name ||
p_delimiter;
l_current_col := l_rec_tab.NEXT(l_current_col);
IF l_current_col IS NULL/*handling for last delimiter for
column */
THEN
l_print_text:=substr(l_print_text,-1);
END IF;
UTL_FILE.PUT (l_file_handle, l_print_text);
EXIT WHEN (l_current_col IS NULL);
END LOOP;
END IF;
UTL_FILE.PUT_LINE (l_file_handle,' ');
LOOP
EXIT WHEN DBMS_SQL.FETCH_ROWS(l_cursor_handle) = 0;
l_current_line := '';
FOR l_current_col IN 1..l_col_cnt LOOP
DBMS_SQL.COLUMN_VALUE (l_cursor_handle, l_current_col, l_column_value);
l_print_text := l_column_value || p_delimiter;
IF l_current_col =l_col_cnt
then
l_current_line := l_current_line || l_column_value;
ELSE
l_current_line := l_current_line || l_column_value ||
p_delimiter;
END IF;
END LOOP;
l_record_count := l_record_count + 1;
UTL_FILE.PUT_LINE (l_file_handle, l_current_line);
END LOOP;
UTL_FILE.FCLOSE (l_file_handle);
DBMS_SQL.CLOSE_CURSOR(l_cursor_handle);
END;

First of all, I'd say procedure which exports CSV file should be named createCSV, makeCSV or something similar, but never parseCSV.
Next, I'm not sure that this application design in best. Usually database should worry of data while external client thinking about medias, formats and so on.
At last, for elimination of trailing delimiter you should use something like this:
...
p_delimiter CHAR -- column delimiter
)
AS
l_delimiter varchar2(1 char);
...
BEGIN
....
l_current_col := l_rec_tab.FIRST;
l_delimiter := '';
....
l_print_text := l_delimiter || l_rec_tab(l_current_col).col_name;
l_delimiter := p_delimiter;
....
/

Try this procedure:
CREATE OR REPLACE PROCEDURE parseCSV(
p_file_dir VARCHAR2, -- Oracle directory name
p_file_name VARCHAR2, -- filename
p_sql_query VARCHAR2, -- select * from table or some such query
p_delimiter CHAR -- column delimiter
)
AS
l_cursor_handle INTEGER;
l_dummy NUMBER;
l_col_cnt INTEGER;
l_rec_tab DBMS_SQL.DESC_TAB;
l_current_col NUMBER(16);
l_current_line VARCHAR2(2047);
l_column_value VARCHAR2(300);
l_file_handle UTL_FILE.FILE_TYPE;
l_print_text VARCHAR2(100);
l_record_count NUMBER(16) := 0;
BEGIN
l_file_handle := UTL_FILE.FOPEN(p_file_dir, p_file_name, 'a', 2047);
l_cursor_handle := DBMS_SQL.OPEN_CURSOR;
DBMS_SQL.PARSE(l_cursor_handle, p_sql_query, DBMS_SQL.native);
l_dummy := DBMS_SQL.EXECUTE(l_cursor_handle);
DBMS_SQL.DESCRIBE_COLUMNS(l_cursor_handle, l_col_cnt, l_rec_tab);
l_current_col := l_rec_tab.FIRST;
IF (l_current_col IS NOT NULL) THEN
LOOP
DBMS_SQL.DEFINE_COLUMN(l_cursor_handle, l_current_col, l_column_value, 300);
IF l_print_text IS NOT NULL THEN
l_print_text := l_print_text || p_delimiter;
END IF;
l_print_text := l_rec_tab(l_current_col).col_name;
UTL_FILE.PUT (l_file_handle, l_print_text);
l_current_col := l_rec_tab.NEXT(l_current_col);
EXIT WHEN (l_current_col IS NULL);
END LOOP;
END IF;
UTL_FILE.PUT_LINE (l_file_handle,' ');
l_print_text := NULL;
LOOP
EXIT WHEN DBMS_SQL.FETCH_ROWS(l_cursor_handle) = 0;
l_current_line := '';
FOR l_current_col IN 1..l_col_cnt LOOP
DBMS_SQL.COLUMN_VALUE (l_cursor_handle, l_current_col, l_column_value);
IF l_print_text IS NOT NULL THEN
l_print_text := l_print_text || p_delimiter;
END IF;
l_print_text := l_column_value;
END LOOP;
l_record_count := l_record_count + 1;
UTL_FILE.PUT_LINE (l_file_handle, l_print_text );
END LOOP;
UTL_FILE.FCLOSE (l_file_handle);
DBMS_SQL.CLOSE_CURSOR(l_cursor_handle);
END;

You can do two things. The first is to update your call to UTL_FILE.put so you conditionally add the delimiter (example below for the header record but the same can be applied to the data) :
IF l_current_col < l_rec_tab.LAST THEN
l_print_text := l_rec_tab(l_current_col).col_name || p_delimiter;
ELSE
l_print_text := l_rec_tab(l_current_col).col_name ;
END IF ;
UTL_FILE.PUT (l_file_handle, l_print_text);
The second approach would be to build up a string with a complete row of data and then manipulate that string before you call UTL FILE (in this case I am assuming l_print_text is long enough for a row of data) :
IF (l_current_col IS NOT NULL) THEN
LOOP
DBMS_SQL.DEFINE_COLUMN(l_cursor_handle, l_current_col, l_column_value, 300);
--append to variable
l_print_text := l_print_text||l_rec_tab(l_current_col).col_name || p_delimiter;
l_current_col := l_rec_tab.NEXT(l_current_col);
EXIT WHEN (l_current_col IS NULL);
END LOOP;
END IF;
--trim trailing delimiter
l_print_text := TRIM(TRAILING p_delimiter FROM l_print_text) ;
--send whole line to file
UTL_FILE.PUT_LINE (l_file_handle,l_print_text);

I have changed your code a little. User this procedure:
CREATE OR REPLACE PROCEDURE PARSECSV
(
P_FILE_DIR VARCHAR2, -- Oracle directory name
P_FILE_NAME VARCHAR2, -- filename
P_SQL_QUERY VARCHAR2, -- select * from table or some such query
P_DELIMITER CHAR -- column delimiter
) IS
L_CURSOR_HANDLE INTEGER;
L_DUMMY NUMBER;
L_COL_CNT INTEGER;
L_REC_TAB DBMS_SQL.DESC_TAB;
L_COLUMN_VALUE VARCHAR2(300);
L_FILE_HANDLE UTL_FILE.FILE_TYPE;
L_PRINT_TEXT CLOB;
BEGIN
L_FILE_HANDLE := UTL_FILE.FOPEN(P_FILE_DIR,
P_FILE_NAME,
'a',
2047);
L_CURSOR_HANDLE := DBMS_SQL.OPEN_CURSOR;
DBMS_SQL.PARSE(L_CURSOR_HANDLE,
P_SQL_QUERY,
DBMS_SQL.NATIVE);
DBMS_SQL.DESCRIBE_COLUMNS(L_CURSOR_HANDLE,
L_COL_CNT,
L_REC_TAB);
FOR L_CURRENT_COL IN 1 .. L_COL_CNT
LOOP
DBMS_SQL.DEFINE_COLUMN(L_CURSOR_HANDLE,
L_CURRENT_COL,
L_COLUMN_VALUE,
300);
IF L_PRINT_TEXT IS NOT NULL THEN
L_PRINT_TEXT := L_PRINT_TEXT || P_DELIMITER;
END IF;
L_PRINT_TEXT := L_PRINT_TEXT || L_REC_TAB(L_CURRENT_COL).COL_NAME;
END LOOP;
L_PRINT_TEXT := L_PRINT_TEXT || CHR(10) || CHR(13);
UTL_FILE.PUT(L_FILE_HANDLE,
L_PRINT_TEXT);
L_PRINT_TEXT := NULL;
L_DUMMY := DBMS_SQL.EXECUTE(L_CURSOR_HANDLE);
DBMS_OUTPUT.PUT_LINE(L_DUMMY);
LOOP
EXIT WHEN DBMS_SQL.FETCH_ROWS(L_CURSOR_HANDLE) = 0;
FOR L_CURRENT_COL IN 1 .. L_COL_CNT
LOOP
DBMS_SQL.COLUMN_VALUE(L_CURSOR_HANDLE,
L_CURRENT_COL,
L_COLUMN_VALUE);
IF L_PRINT_TEXT IS NOT NULL THEN
L_PRINT_TEXT := L_PRINT_TEXT || P_DELIMITER;
END IF;
L_PRINT_TEXT := L_PRINT_TEXT || L_COLUMN_VALUE;
END LOOP;
L_PRINT_TEXT := L_PRINT_TEXT || CHR(10) || CHR(13);
UTL_FILE.PUT(L_FILE_HANDLE,
L_PRINT_TEXT);
END LOOP;
UTL_FILE.FCLOSE(L_FILE_HANDLE);
DBMS_SQL.CLOSE_CURSOR(L_CURSOR_HANDLE);
END;

First, create a directory in the database and provide the read, write access to that directory.
To create a directory:
CREATE OR REPLACE DIRECTORY alias AS 'pathname';
To Grant Read,Write:
GRANT read,write ON DIRECTORY alias TO {user | role | PUBLIC};
After that use below stored procedure to get the output of SQL query in any file format.
CREATE OR REPLACE PROCEDURE CSV_EXPORT AS
CURSOR c_data IS
SELECT * from table_name;
v_file UTL_FILE.FILE_TYPE;
BEGIN
v_file := UTL_FILE.FOPEN(location => 'FILES1',
filename => 'csv_exp.txt',
open_mode => 'w',
max_linesize => 32767);
FOR cur_rec IN c_data LOOP
UTL_FILE.PUT_LINE(v_file,
cur_rec.column1 || ',' ||
cur_rec.column2 );
END LOOP;
UTL_FILE.FCLOSE(v_file);
EXCEPTION
WHEN OTHERS THEN
UTL_FILE.FCLOSE(v_file);
RAISE;
END;
To run the stored procedure:
EXEC CSV_EXPORT;
here in code FILES1 is directory name.

TidTcpserver Verify commands List

I Am trying to protect my Tidtcpserver from unknown commands
This is how my Verify commands function looks like
function TConnection.Verfieycmds(const CMSTOV: String): BOOLEAN;
var
CMDSTOVERFIYE : Tstringlist;
I : integer;
CommandFound : Boolean;
begin
Result := False;
CommandFound := False;
if Commandlist <> nil then
begin
CMDSTOVERFIYE := Commandlist.Lock;
try
for I := 0 to CMDSTOVERFIYE.Count - 1 do
begin
if CMSTOV = CMDSTOVERFIYE[I] then
begin
CommandFound := True;
end;
end;
CommandFound := True;
Result := CommandFound;
finally
Commandlist.Unlock;
end;
end;
end;
after adding this check on execute event and after few clients connect the server application freezed and need to be restarted and the exception log were empty
here is my server code
type
TConnection = class(TIdServerContext)
private
{Private}
public
{Public}
OutboundCache: TIdThreadSafeStringList;
Commandlist: TIdThreadSafeStringList;
LastSendRecv: TIdTicks;
Name: String;
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
type
TServobj = class(TForm)
TcpServer: TIdTCPServer;
Panel1: TPanel;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
procedure TcpServerConnect(AContext: TIdContext);
procedure TcpServerDisconnect(AContext: TIdContext);
procedure TcpServerExecute(AContext: TIdContext);
procedure FormCloseQuery(Sender: TObject; var CanClose: BOOLEAN);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TcpServerListenException(AThread: TIdListenerThread;
AException: Exception);
private
{ Private declarations }
LastUniqueID: Dword;
procedure HandleExceptions(Sender: TObject; E: Exception);
procedure UpdateBindings;
public
{ Public declarations }
end;
var
Servobj: TServobj;
implementation
uses
dmoudle;
{$R *.dfm}
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn;
AList: TIdContextThreadList = nil);
begin
inherited;
OutboundCache := TIdThreadSafeStringList.Create;
Commandlist := TIdThreadSafeStringList.Create;
Commandlist.Add('Command1');
Commandlist.Add('Command2');
Commandlist.Add('Command3');
Commandlist.Add('Command4');
Commandlist.Add('Command5');
Commandlist.Add('Command6');
Commandlist.Add('Command7');
Commandlist.Add('Command8');
Commandlist.Add('Command9');
Commandlist.Add('Command10');
Commandlist.Add('Command11');
Commandlist.Add('Command12');
end;
destructor TConnection.Destroy;
var
Cache: TStringList;
Commadcaches : TStringList;
I: integer;
begin
if OutboundCache <> nil then
begin
Cache := OutboundCache.Lock;
try
for I := 0 to Cache.Count - 1 do
Cache.Objects[I].Free;
finally
OutboundCache.Unlock;
end;
OutboundCache.Free;
end;
if Commandlist <> nil then
begin
Commadcaches := Commandlist.Lock;
try
for I := 0 to Commadcaches.Count - 1 do
Commadcaches.Objects[I].Free;
finally
Commandlist.Unlock;
end;
Commandlist.Free;
end;
inherited;
end;
procedure TServobj.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command: String;
Startercommand : String;
Params: array [1 .. 200] of String;
Cache, OutboundCmds: TStringList;
ParamsCount, P: integer;
I: integer;
S: String;
DECODES : String;
UConnected : Boolean;
Len: Integer;
begin
Try
UConnected := AContext.Connection.Connected;
Except
UConnected := False;
End;
If Not UConnected Then
begin
AContext.Connection.Disconnect;
exit;
end;
Len := AContext.Connection.IOHandler.InputBuffer.Size;
If Len >= 200000 then
begin
AContext.Connection.Disconnect;
exit;
end;
Connection := AContext as TConnection;
// check for pending outbound commands...
OutboundCmds := nil;
try
Cache := Connection.OutboundCache.Lock;
try
if Cache.Count > 0 then
begin
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
end;
finally
Connection.OutboundCache.Unlock;
end;
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
AContext.Connection.IOHandler.Writeln(OutboundCmds.Strings[I],
IndyTextEncoding_UTF8);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8;
AContext.Connection.IOHandler.LargeStream := true;
AContext.Connection.IOHandler.Write(MS, 0, true);
end;
end;
Connection.LastSendRecv := Ticks64;
end;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
OutboundCmds.Objects[I].Free;
end;
end;
OutboundCmds.Free;
end;
// check for a pending inbound command...
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
AContext.Connection.IOHandler.CheckForDataOnSource(100);
AContext.Connection.IOHandler.CheckForDisconnect;
if AContext.Connection.IOHandler.InputBufferIsEmpty then
begin
if GetElapsedTicks(Connection.LastSendRecv) >= 60000 then
AContext.Connection.Disconnect;
Exit;
end;
end;
Startercommand := Decode64(AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8), IndyTextEncoding_UTF8);
Command := Startercommand;
{HERE I START TO CHECK COMMAND LIST}
if (command <> 'ISACTIVE') then
begin
if Connection.Verfieycmds(Command) <> true then
begin
AContext.Connection.Disconnect;
Exit;
end;
end;
{HERE I START TO CHECK COMMAND LIST}
Connection.LastSendRecv := Ticks64;
if Command = '' then
begin
AContext.Connection.Disconnect;
Exit;
end;
ReceiveParams := False;
ReceiveStream := False;
if Command[1] = '1' then // command with params
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := true;
end
else if Command[1] = '2' then // command + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveStream := true;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Command := Copy(Command, 2, MaxInt);
ReceiveParams := true;
ReceiveStream := true;
end;
if ReceiveParams then // params is incomming
begin
S := AContext.Connection.Socket.ReadLn(IndyTextEncoding_UTF8);
DECODES := Decode64(S, IndyTextEncoding_UTF8);
ParamsCount := 0;
while (DECODES <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, DECODES);
if P = 0 then
Params[ParamsCount] := DECODES
else
begin
Params[ParamsCount] := Copy(DECODES, 1, P - 1);
Delete(DECODES, 1, P + 5);
end;
end;
end;
if Command = 'Broadcastanymessage' then
begin
if ParamsCount <> 3 then
begin
AContext.Connection.Disconnect;
Exit;
end;
//do something
end;
end;
if i remove the Verfieycmds from the execute check the server running normally . what i am doing wrong ?

There is no reason to use a TIdThreadSafeStringList for the commands list. Only the thread that creates the list will ever be accessing it, so using a lock for it is unnecessary overhead.
And there is no reason to allocate a new list for each client, for that matter. That is just wasting memory.
Your commands are encoded in a manner that requires decoding before you can then validate them.
Try something more like this instead:
type
TConnection = class(TIdServerContext)
private
function HasInboundData: Boolean;
procedure SendOutboundCache;
public
OutboundCache: TIdThreadSafeStringList;
LastSendRecv: TIdTicks;
// ...
constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override;
destructor Destroy; override;
end;
type
TServobj = class(TForm)
TcpServer: TIdTCPServer;
//...
procedure TcpServerConnect(AContext: TIdContext);
//...
procedure TcpServerExecute(AContext: TIdContext);
procedure FormCreate(Sender: TObject);
//...
private
//...
end;
var
Servobj: TServobj;
implementation
uses
dmoudle;
{$R *.dfm}
constructor TConnection.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil);
begin
inherited;
OutboundCache := TIdThreadSafeStringList.Create;
LastSendRecv := Ticks64;
end;
destructor TConnection.Destroy;
var
Cache: TStringList;
I: integer;
begin
if OutboundCache <> nil then
begin
Cache := OutboundCache.Lock;
try
for I := 0 to Cache.Count - 1 do
Cache.Objects[I].Free;
finally
OutboundCache.Unlock;
end;
OutboundCache.Free;
end;
inherited;
end;
function TConnection.HasInboundData: Boolean;
begin
if Connection.IOHandler.InputBufferIsEmpty then
begin
Connection.IOHandler.CheckForDataOnSource(100);
Connection.IOHandler.CheckForDisconnect;
if Connection.IOHandler.InputBufferIsEmpty then
begin
if GetElapsedTicks(LastSendRecv) >= 60000 then
Connection.Disconnect;
Result := False;
Exit;
end;
end;
Result := True;
end;
procedure TConnection.SendOutboundCache;
var
Cache, OutboundCmds: TStringList;
MS: TMemoryStream;
I: integer;
begin
OutboundCmds := nil;
try
Cache := OutboundCache.Lock;
try
if Cache.Count = 0 then
Exit;
OutboundCmds := TStringList.Create;
OutboundCmds.Assign(Cache);
Cache.Clear;
finally
OutboundCache.Unlock;
end;
for I := 0 to OutboundCmds.Count - 1 do
begin
Connection.IOHandler.WriteLn(OutboundCmds.Strings[I]);
MS := TMemoryStream(OutboundCmds.Objects[I]);
if MS <> nil then
begin
Connection.IOHandler.LargeStream := true;
Connection.IOHandler.Write(MS, 0, true);
end;
end;
LastSendRecv := Ticks64;
finally
if OutboundCmds <> nil then
begin
for I := 0 to OutboundCmds.Count - 1 do
begin
OutboundCmds.Objects[I].Free;
end;
end;
OutboundCmds.Free;
end;
end;
procedure TServobj.FormCreate(Sender: TObject);
begin
TcpServer.ContextClass := TConnection;
end;
procedure TServobj.TcpServerConnect(AContext: TIdContext);
begin
AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_UTF8
end;
const
ValidCmds: array[0..13] of String = (
'ISACTIVE',
'Broadcastanymessage',
'Command1',
'Command2',
'Command3',
'Command4',
'Command5',
'Command6',
'Command7',
'Command8',
'Command9',
'Command10',
'Command11',
'Command12'
);
procedure TServobj.TcpServerExecute(AContext: TIdContext);
var
Connection: TConnection;
Command, Decoded: String;
Params: array[1..200] of String;
ParamsCount, P, I, WhichCmd: integer;
begin
Connection := AContext as TConnection;
// check for pending outbound commands...
Connection.SendOutboundCache;
// check for a pending inbound command...
if not Connection.HasInboundData then
Exit;
Command := Decode64(AContext.Connection.IOHandler.ReadLn, IndyTextEncoding_UTF8);
ReceiveParams := False;
ReceiveStream := False;
if Command <> '' then
begin
if Command[1] = '1' then // command with params
begin
Delete(Command, 1, 1);
ReceiveParams := true;
end
else if Command[1] = '2' then // command + memorystream
begin
Delete(Command, 1, 1);
ReceiveStream := true;
end
else if Command[1] = '3' then // command with params + memorystream
begin
Delete(Command, 1, 1);
ReceiveParams := true;
ReceiveStream := true;
end;
end;
WhichCmd := PosInStrArray(Command, ValidCmds);
if WhichCmd = -1 then
begin
AContext.Connection.Disconnect;
Exit;
end;
if ReceiveParams then // params is incomming
begin
Decoded := Decode64(AContext.Connection.IOHandler.ReadLn, IndyTextEncoding_UTF8);
ParamsCount := 0;
while (Decoded <> '') and (ParamsCount < 200) do
begin
Inc(ParamsCount);
P := Pos(Sep, Decoded);
if P = 0 then
Params[ParamsCount] := Decoded
else
begin
Params[ParamsCount] := Copy(Decoded, 1, P - 1);
Delete(Decoded, 1, P + Length(Sep));
end;
end;
end;
Connection.LastSendRecv := Ticks64;
case WhichCmd of
// process commands as needed...
1: begin // Broadcastanymessage
if ParamsCount <> 3 then
begin
AContext.Connection.Disconnect;
Exit;
end;
//do something
end;
// ...
end;
end;

Can I hold two locks simultaneously with Oracle PL/SQL?

The current locking concept of my application assumes to get hold of 2 locks and perform code. But I always get an error when I try to release the first lockhandle. Is there a way to do this or am I wrong using dbms_lock to get 2 locks at one time?
Best regards!
DECLARE
l_handle_1 VARCHAR2(128);
l_handle_2 VARCHAR2(128);
l_result NUMBER;
BEGIN
-- >>> LOCK1
dbms_lock.allocate_unique('lock_1', l_handle_1);
l_result := dbms_lock.request(l_handle_1, dbms_lock.x_mode, 10, true);
BEGIN
-- >>> LOCK2
dbms_lock.allocate_unique('lock_2', l_handle_2);
l_result := dbms_lock.request(l_handle_2, dbms_lock.x_mode, 10, true);
BEGIN
/*
* PLSQL-Code with both locks held
*/
-- LOCK-2 release
l_result := dbms_lock.release(l_handle_2);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 2');
END IF;
-- LOCK-1 release
l_result := dbms_lock.release(l_handle_1);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 1');
END IF;
EXCEPTION
WHEN OTHERS THEN
l_result := dbms_lock.release(l_handle_2);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 3');
END IF;
RAISE;
END;
EXCEPTION
WHEN OTHERS THEN
l_result := dbms_lock.release(l_handle_1);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 4');
END IF;
RAISE;
END;
END;

you call dbms_lock.request with release_on_commit = TRUE for the first lock handle and then call allocate_unique.
allocate_unique performs a commit and hence releases the first lock.
You will not get an error if you change you code as follows:
DECLARE
l_handle_1 VARCHAR2(128);
l_handle_2 VARCHAR2(128);
l_result NUMBER;
BEGIN
dbms_lock.allocate_unique('lock_1', l_handle_1);
dbms_lock.allocate_unique('lock_2', l_handle_2);
-- >>> LOCK1
l_result := dbms_lock.request(l_handle_1, dbms_lock.x_mode, 10, true);
BEGIN
-- >>> LOCK2
-- dbms_lock.allocate_unique('lock_2', l_handle_2);
l_result := dbms_lock.request(l_handle_2, dbms_lock.x_mode, 10, true);
BEGIN
/*
* PLSQL-Code with both locks held
*/
-- LOCK-2 release
l_result := dbms_lock.release(l_handle_2);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 2');
END IF;
-- LOCK-1 release
l_result := dbms_lock.release(l_handle_1);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 1');
END IF;
EXCEPTION
WHEN OTHERS THEN
l_result := dbms_lock.release(l_handle_2);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 3');
END IF;
RAISE;
END;
EXCEPTION
WHEN OTHERS THEN
l_result := dbms_lock.release(l_handle_1);
IF (l_result > 0) THEN
dbms_output.put_line('Fail 4');
END IF;
RAISE;
END;
END;

Develop Reference

ruby bash windows laravel spring algorithm oracle macos go visual-studio

Reduce The Lengthly Code In Firemonkey - firemonkey

Related

search in multilevel linked lists in Pascal

Monotone chain change data structure to doubly linked list

Export query result to csv in oracle stored procedure

TidTcpserver Verify commands List

Can I hold two locks simultaneously with Oracle PL/SQL?

Categories

Resources