unit Test;
interface
var number: Integer;
num1, num2: string;
implementation
begin
number:=1;
if number=1 then begin
num+number:='value 1';
end
else if number=2 then begin
num+number:='value 2';
end;
showmessage(num+number,'');
end.
I want to show this result "value 1" if number = 1 and "value 2" if number = 2.
You could use an array, as the numbers are sequential, eg:
unit Test;
interface
var
number: Integer;
num: array[1..2] of string;
implementation
begin
number := 1;
if number = 1 then begin
num[number] := 'value 1';
end
else if number=2 then begin
num[number] := 'value 2';
end;
ShowMessage(num[number]);
end.
use Format
var number: integer;
value: string;
begin
value := format('value %d', [number]);
end;
it will give "Value (n)" as in "value 1" if you put 1 in the variabel
Related
I need to get the output of the execution of my script and integrate it into the installer, everything works well, but I need to add a "cancel" button, it will not be difficult to add a button, but during the execution of the timer, the entire installer window is blocked, but I can not minimize to tray and press any button.
function SetTimer(
Wnd: LongWord; IDEvent, Elapse: LongWord; TimerFunc: LongWord): LongWord;
external 'SetTimer#user32.dll stdcall';
function KillTimer(hWnd: LongWord; uIDEvent: LongWord): BOOL;
external 'KillTimer#user32.dll stdcall';
var
ProgressFileName: string;
function BufferToAnsi(const Buffer: string): AnsiString;
var
W: Word;
I: Integer;
begin
SetLength(Result, Length(Buffer) * 2);
for I := 1 to Length(Buffer) do
begin
W := Ord(Buffer[I]);
Result[(I * 2)] := Chr(W shr 8); { high byte }
Result[(I * 2) - 1] := Chr(Byte(W)); { low byte }
end;
end;
procedure UpdateProgress;
var
S: AnsiString;
I, L, Max: Integer;
Buffer: string;
Stream: TFileStream;
Lines: TStringList;
begin
if not FileExists(ProgressFileName) then
begin
Log(Format('Progress file %s does not exist', [ProgressFileName]));
end
else
begin
try
Stream := TFileStream.Create(ProgressFileName, fmOpenRead or fmShareDenyNone);
try
L := Stream.Size;
Max := 100*2014;
if L > Max then
begin
Stream.Position := L - Max;
L := Max;
end;
SetLength(Buffer, (L div 2) + (L mod 2));
Stream.ReadBuffer(Buffer, L);
S := BufferToAnsi(Buffer);
finally
Stream.Free;
end;
except
Log(Format('Failed to read progress from file %s - %s', [
ProgressFileName, GetExceptionMessage]));
end;
end;
if S <> '' then
begin
Log('Progress len = ' + IntToStr(Length(S)));
Lines := TStringList.Create();
Lines.Text := S;
for I := 0 to Lines.Count - 1 do
begin
if I < ProgressListBox.Items.Count then
begin
ProgressListBox.Items[I] := Lines[I];
end
else
begin
ProgressListBox.Items.Add(Lines[I]);
end
end;
ProgressListBox.ItemIndex := ProgressListBox.Items.Count - 1;
ProgressListBox.Selected[ProgressListBox.ItemIndex] := False;
Lines.Free;
end;
ProgressPage.SetProgress(0, 1);
end;
procedure UpdateProgressProc(
H: LongWord; Msg: LongWord; Event: LongWord; Time: LongWord);
begin
UpdateProgress;
end;
procedure RunInstallBatInsideProgress;
var
ResultCode: Integer;
Timer: LongWord;
AppPath: string;
AppError: string;
Command: string;
begin
ProgressPage :=
CreateOutputProgressPage(
'Installing something', 'Please wait until this finishes...');
ProgressPage.Show();
ProgressListBox := TNewListBox.Create(WizardForm);
ProgressListBox.Parent := ProgressPage.Surface;
ProgressListBox.Top := 0;
ProgressListBox.Left := 0;
ProgressListBox.Width := ProgressPage.SurfaceWidth;
ProgressListBox.Height := ProgressPage.SurfaceHeight;
ProgressPage.ProgressBar.Top := -100;
try
Timer := SetTimer(0, 0, 250, CreateCallback(#UpdateProgressProc));
AppPath := ExpandConstant('{app}\installer.py');
ProgressFileName := ExpandConstant('{app}\tmp\installer-progress.log');
Log(Format('Expecting progress in %s', [ProgressFileName]));
Command := Format('""%s" > "%s""', [AppPath, ProgressFileName]);
if not Exec(ExpandConstant('{cmd}'), '/c ' + Command + ExpandConstant(' {app}\PIPE'), '', SW_HIDE, ewWaitUntilTerminated, ResultCode) then
begin
AppError := 'Cannot start app';
end
else
if ResultCode <> 0 then
begin
AppError := Format('App failed with code %d', [ResultCode]);
end;
UpdateProgress;
finally
KillTimer(0, Timer);
ProgressPage.Hide;
DeleteFile(ProgressFileName);
ProgressPage.Free();
end;
if AppError <> '' then
begin
RaiseException(AppError);
end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep=ssPostInstall then
begin
RunInstallBatInsideProgress;
end
end;
enter image description here
This is my PL/SQL error:
Error report
ORA-01422: exact fetch returns more than requested number of rows
ORA-06512: at line 67
00000 - "exact fetch returns more than requested number of rows"
*Cause: The number specified in exact fetch is less than the rows returned.
*Action: Rewrite the query or change number of rows requested
PL/SQL script:
DECLARE
cursor cur is (select distinct sor_ident
from CLEVA_OWNER_BE.f_polices, CLEVA_OWNER_BE.f_sit_objet_risque, CLEVA_OWNER_BE.f_produitass, cleva_owner_be.f_desc_stat_100, CLEVA_OWNER_BE.f_p_c_client, CLEVA_OWNER_BE.f_garantie_dyn
where pol_ident = sor_ptrpolid
and sor_ident = d100_ptrsorid
and bpcl_ident = pol_ptrclid
and pol_ptrpasid = pas_ident
and sor_ident = gad_ptrsorid
and pas_code_produit IN ('BFOV','BFOV2','BFOV5','BFOV6')
and BPCL_LIB24 = '1'
and d100_lib01 IN ('1','2','4','5','6')
and d100_lib09 > '1997'
and ( pol_codetat in ('1', '3', '6') or ( pol_codetat = '0' and pol_datcre > trunc ( sysdate - 183 ) ) )
and gad_code IN('RCVVY','RCLTY','RCVCT','RCHTY')
);
type tt_cur is varray(50) of cur%rowtype;
t_cur tt_cur;
type tt_cld is varray(50) of CLEVA_OWNER_BE.f_clause_dyn%rowtype;
t_cld tt_cld := tt_cld();
cld_key pls_integer;
v_ordre varchar2(3900);
v_desc varchar2(5000);
v_titre varchar2(5000);
BEGIN
t_cld.extend();
t_cld(1).CLD_IDENT := null;
t_cld(1).CLD_PTRSORID := null;
t_cld(1).CLD_TEXTE := null;
t_cld(1).CLD_ORDRE := null;
t_cld(1).CLD_CODE := 'RCVT7';
t_cld(1).CLD_SEQUENTIEL := null;
t_cld(1).CLD_SERVICES := null;
t_cld(1).CLD_INT_LOT_IMP := null;
t_cld(1).CLD_INT_LOT_EXP := null;
t_cld(1).CLD_LIBRE := 0;
t_cld(1).CLD_CHAPITRE := null;
t_cld(1).CLD_S_CHAPITRE := null;
t_cld(1).CLD_SS_CHAPITRE := null;
t_cld(1).CLD_TYPE := 2;
t_cld(1).CLD_TABLE := null;
t_cld(1).CLD_REFECHO := null;
t_cld(1).CLD_PTRSARID := null;
t_cld(1).CLD_TITRE := null;
t_cld.extend(49,1);
Line 67 select nvl( max(CLD_ident), 30000000) into cld_key
from CLEVA_OWNER_BE.f_clause_dyn
where CLD_ident between 30000000 and 49999999;
select TGA_ORDRE, tga_description, tga_titre into v_ordre, v_desc, v_titre
from cleva_owner_be.f_tarif_gar
where TGA_CODE = 'RCVT7';
OPEN cur;
LOOP
FETCH cur BULK COLLECT INTO t_cur LIMIT 50 ;
FOR i IN 1 .. t_cur.COUNT
LOOP
cld_key := cld_key + 1;
t_cld(i).CLD_IDENT := cld_key;
t_cld(i).CLD_PTRSORID := t_cur(i).sor_ident;
t_cld(i).CLD_TEXTE := v_desc;
t_cld(i).CLD_TITRE := v_titre;
t_cld(i).CLD_ORDRE := v_ordre;
END LOOP;
FORALL j IN 1..t_cur.COUNT
INSERT INTO CLEVA_OWNER_BE.f_clause_dyn VALUES t_cld(j);
COMMIT;
EXIT WHEN cur%NOTFOUND ;
END LOOP;
END
;
I am trying to create a structure:
MyTopic
TopicID : String;
HelpID : Integer;
I wanted to create an array of these structures so I could sort them.
I have tried using this type / record syntax but it is failing.
Update
I defined this type and procedure:
type
TMyTopicRecord = record
idTopic : String;
idContextHelp : integer;
End;
procedure GetSortedTopicIDs(aTopics : array of String; size : Integer);
var
aMyTopicRecords : array of TMyTopicRecord;
temp : TMyTopicRecord;
iTopic, i, j : Integer;
begin
// Init the array
SetLength(aMyTopicRecords, size);
// Fill the array with the existing topid ids.
// Get the context ids at the same time.
for iTopic := 0 to size - 1 do
aMyTopicRecords[iTopic].idTopic := aTopics[iTopic];
aMyTopicRecords[iTopic].idContextHelp := HndTopics.GetTopicHelpContext(aTopics[iTopic]);
// Sort the array on context id
for i := size-1 DownTo 1 do
for j := 2 to i do
if (aMyTopicRecords[j-1].idContextHelp > aMyTopicRecords[j].idContextHelp) Then
begin
temp := aMyTopicRecords[j-1];
aMyTopicRecords[j-1] := aMyTopicRecords[j];
aMyTopicRecords[j] := temp;
end;
// Rebuild the original array of topic ids
for iTopic := 0 to size - 1 do
aTopics[iTopic] := aMyTopicRecords[iTopic].idTopic;
end;
The procedure gets called in a loop of the parent function (code snipped):
function GetKeywordsAsHtml(): string;
var
aKeywordList: THndKeywordsInfoArray;
aAssociatedTopics: array of string;
nBlocLevel, nDif, nClose, nCurKeywordLevel, nCurKeywordChildrenCnt: Integer;
nCurKeyword, nCurKeywordTopic: Integer;
nCountAssociatedTopics: Integer;
sCurrentKeyword, sKeywordLink, sKeywordRelated: string;
sKeywordJsCaption: string;
begin
Result := '<ul>';
nBlocLevel := 0;
try
aKeywordList := HndKeywords.GetKeywordList(False);
for nCurKeyword := 0 to length(aKeywordList) - 1 do
begin
sCurrentKeyword := aKeywordList[nCurKeyword].id;
nCurKeywordLevel := HndKeywords.GetKeywordLevel(sCurrentKeyword);
nCurKeywordChildrenCnt := HndKeywords.GetKeywordDirectChildrenCount(sCurrentKeyword);
sKeywordLink := '#';
sKeywordRelated := '[]';
aAssociatedTopics := HndTopicsKeywords.GetTopicsAssociatedWithKeyword(sCurrentKeyword);
nCountAssociatedTopics := Length(aAssociatedTopics);
if nCountAssociatedTopics > 0 then
begin
GetSortedTopicIDs(aAssociatedTopics, nCountAssociatedTopics);
// Code snipped
end;
end;
finally
Result := Result + '</ul>';
end;
end;
The script compiled in the HelpNDoc internal editor with no issues. But when I go to actually build my HTML documentation I encounter a problem:
The HelpNDoc API is explained here.
Is there something wrong with my code?
I decided to go about it a different way and used a simpler technique:
procedure GetSortedTopicIDs(var aTopics : array of String; iNumTopics : Integer);
var
iTopic : Integer;
// List of output
aList: TStringList;
begin
// Init list
aList := TStringList.Create;
// Build a new array of "nnn x"
// - nnn is the help context id
// - x is the topid id
// Note: I know that the context ID values are within the range 0 - 200
for iTopic := 0 to iNumTopics - 1 do
// We pad the context id with 0. We could increase the padding width to
// make the script mre useful
aList.Add(Format('%0.3d %s', [
HndTopics.GetTopicHelpContext(aTopics[iTopic]),
aTopics[iTopic]
]));
// Now we sort the new array (which basically sorts it by context id)
aList.Sort;
// Update original array
for iTopic := 0 to iNumTopics - 1 do
// We ignore the "nnn " part of the string to get just the topic id
aTopics[iTopic] := copy(aList[iTopic],5, length(aList[iTopic])-4);
// Tidy up
aList.Free;
end;
This compiles and I get the sorted array of topic IDs at the end of it. So the pop-up help is now listed as I want.
I have the following function GET_UN_COLLECTED_4LD which returns the type ld_data_type:
CREATE OR REPLACE TYPE ld_data_type AS OBJECT(collected NUMBER, uncollected NUMBER);
/
CREATE OR REPLACE FUNCTION GET_UN_COLLECTED_4LD (VAPPOINTOFCAID NUMBER,
VPREVLIQUIDATE NUMBER,
VCURRLIQUIDATE NUMBER,
VNEXTLIQUIDATE NUMBER,
YEPT NUMBER)
RETURN LD_DATA_TYPE
AS
OUT_VAR LD_DATA_TYPE;
VNETV23 NUMBER;
VNETV24 NUMBER;
VCURR23 NUMBER;
VCURR24 NUMBER;
VCOLLECTED NUMBER;
VUNCOLLECTED NUMBER;
BEGIN
SELECT SUM (NETX) - SUM (NETP)
INTO VNETV23
FROM VIEW_CUSTOMER_TRN4INVS4LD
WHERE APPOINTOFCAID = VAPPOINTOFCAID AND VAT = ABS (1.23);
SELECT SUM (NETX) - SUM (NETP)
INTO VNETV24
FROM VIEW_CUSTOMER_TRN4INVS4LD
WHERE APPOINTOFCAID = VAPPOINTOFCAID AND VAT = ABS (1.24);
VCOLLECTED := 0;
VUNCOLLECTED := 0;
CASE
WHEN YEPT = 0
THEN
VCURR24 := VCURRLIQUIDATE - VNETV24;
CASE
WHEN VCURR24 > 0
THEN
VCOLLECTED := VNETV24 * 1.24;
VCURR23 := VCURRLIQUIDATE - VNETV23;
CASE
WHEN VCURR23 > 0
THEN
VCOLLECTED := -999;
ELSE
VCOLLECTED :=
VCOLLECTED + ( (VCURRLIQUIDATE - VCURR24) * 1.23);
END CASE;
ELSE
VCOLLECTED := -1999;
END CASE;
ELSE
OUT_VAR.COLLECTED := -888;
OUT_VAR.UNCOLLECTED := -889;
END CASE;
SELECT VCOLLECTED, VUNCOLLECTED
INTO OUT_VAR.COLLECTED, OUT_VAR.UNCOLLECTED
FROM DUAL;
/*
OPEN buffer_cur;
FETCH buffer_cur INTO out_var.val1, out_var.val2;
CLOSE buffer_cur; */
RETURN OUT_VAR;
END GET_UN_COLLECTED_4LD;
When I call the function like
select GET_UN_COLLECTED_4LD(171231, 42240, 31680, 0, 0) from dual;`
I get an error:
Execution (50: 8): ORA-06530: Reference to uninitialized composite
ORA-06512: at "C##SOLSA.GET_UN_COLLECTED_4LD", line 56
I'm use Oracle 12c Standard edition.
How should I be calling the function GET_UN_COLLECTED_4LD and Where is the problem that causes the error?
As the error says, you haven't initialised your object variable:
...
RETURN LD_DATA_TYPE
AS
OUT_VAR LD_DATA_TYPE := new LD_DATA_TYPE(null, null);
...
Your logic is slightly confused though; at the end of your case you do:
ELSE
OUT_VAR.COLLECTED := -888;
OUT_VAR.UNCOLLECTED := -889;
but then overwrite the value immediately afterwards with:
SELECT VCOLLECTED, VUNCOLLECTED
INTO OUT_VAR.COLLECTED, OUT_VAR.UNCOLLECTED
FROM DUAL;
Possibly you meant to set VCOLLECTED and VUNCOLLECTED in that ELSE. If you did that then you wouldn't need to initialise OUT_VAR, as the first remaining reference would create it; which you could do as:
OUT_VAR := LD_DATA_TYPE (VCOLLECTED, VUNCOLLECTED);
instead of selecting from dual; or you could not have the local variable at all and just do:
...
ELSE
VCOLLECTED := -888;
VUNCOLLECTED := -889;
END CASE;
RETURN LD_DATA_TYPE (VCOLLECTED, VUNCOLLECTED);
END GET_UN_COLLECTED_4LD;
First you need to initialize your object type OUT_VAR before you can set its properties like this:
OUT_VAR:= LD_DATA_TYPE(0,0);
See the details here.
The task is to create new list which contains 2 linear lists, and if elements of first list equal to elements of second list then we must delete the same element from new list
procedure CreateList(var t1,L1,t2,L2:plist);
var
tmp1, tmp2:plist;
begin
t1 := L1;
t2 := L2;
while t1 <> nil do
begin
write(t1^.Data, ' ');
t1 := t1^.Next;
while t2 <> nil do
begin
write(t2^.data, ' ');
tmp2:=t2;
t2 := t2^.Next;
if(t2 = tmp1^.next) then // here is the problem how to compare 2 elements
begin
tmp1 := t1;
t1 := t1^.Next;
Dispose(tmp1);
end;
end;
end;
Writeln;
readkey;
end;
I advise you to change type of you list for something like:
type
TData = integer;
PList = ^TList;
TList = record
data : TData;
next : PList;
copy : boolean;
end;
After you will use value .copy for checking copys. Here is simple code you need.
I tried to make all code as simple as possible.
procedure deleteCopys(var list:PList);
// make all TList.copy := false (after we will use it)
var
curList : PList;
begin
curList := list;
while (curList<>nil) do
begin
curList^.copy := false;
curList := curList^.next;
End;
End;
procedure createList(var list1, list2, list3:PList);
// we belive that: (list3 is empty) and (there is no copys in list1)
// and (there is no copys in list2)
var
curList1, curList2 : PList;
begin
deleteCopys(list1);
deleteCopys(list2);
deleteCopys(list3);
// make TList.copy := true for equal elements
// from curList1 and curList2
curList1 := list1;
while (curList1 <> nil) do
begin
curList2 := list2;
while (curList2 <> nil) do
begin
if (curList1^.data = curList2^.data) then
begin
curList1^.copy := true;
curList2^.copy := true;
break;
End;
curList2 := curList2^.next;
End;
curList1 := curList1^.next;
End;
// now we can put all elements from list1 and list2
// with state TLilt.copy=false
// and each of them will be different
// (Let's do it :)
curList1 := list1;
while (curList1 <> nil) do
begin
if (curList1^.copy = false) then
begin
//some procedure for new element
putNewElement(list3, curList1^.data);
End;
End;
curList2 := list2;
while (curList2 <> nil) do
begin
if (curList2^.copy = false) then
begin
//some procedure for new element
putNewElement(list3, curList2^.data);
End;
End;
end;
I hope it will help you!