Command Line Parms: Function Return Type As Array? - arrays

Here's the current problem:
Executing an uninstall string with command line parameters following this solution:
Here's what we have in the form of non-functioning code:
const MAX_PATH = 260;
function GetUninstallString(): TArrayOfString;
var
sUnInstPath: String;
sUnInstallString: String;
sUnInstallStringPrm: String;
begin
sUnInstPath := ExpandConstant('Software\Microsoft\Windows\CurrentVersion\Uninstall\{#MyAppName}');
sUnInstallString := '';
if not RegQueryStringValue(HKLM, sUnInstPath, 'UninstallString', sUnInstallString) then
RegQueryStringValue(HKCU, sUnInstPath, 'UninstallString', sUnInstallString);
if sUnInstallString = '' Then
Begin
sUnInstPath := ExpandConstant('Software\WOW6432Node\Microsoft\Windows\CurrentVersion\Uninstall\{#MyAppName}');
RegQueryStringValue(HKLM, sUnInstPath, 'UninstallString', sUnInstallString);
End;
if sUnInstallString <> '' Then
Begin
sUnInstallStringPrm:= copy(sUnInstallString, pos(' ', sUnInstallString) + 1, MAX_PATH);
MsgBox(sUnInstallStringPrm, mbInformation, MB_OK);
Delete(sUnInstallString, pos(' ', sUnInstallString), MAX_PATH);
End;
Result := [sUnInstallString, UnInstallStringPrm];
end;
/////////////////////////////////////////////////////////////////////
function IsUpgrade(): Boolean;
begin
Result := (GetUninstallString() <> '');
end;
/////////////////////////////////////////////////////////////////////
function UnInstallOldVersion(): Integer;
var
sUnInstallString: String;
iResultCode: Integer;
begin
// Return Values:
// 1 - uninstall string is empty
// 2 - error executing the UnInstallString
// 3 - successfully executed the UnInstallString
// default return value
Result := 0;
// get the uninstall string of the old app
sUnInstallString := GetUninstallString();
if sUnInstallString <> '' then begin
sUnInstallString := RemoveQuotes(sUnInstallString);
if ShellExec('open', sUnInstallString, '','', SW_SHOW, ewWaitUntilTerminated, iResultCode) then
Result := 3
else
Result := 2;
end else
Result := 1;
end;
/////////////////////////////////////////////////////////////////////
procedure CurStepChanged(CurStep: TSetupStep);
begin
if (CurStep=ssInstall) then
begin
if (IsUpgrade()) then
begin
UnInstallOldVersion();
end;
end;
end;
There is very little info on how to use GetUninstallString in this context. Possible at all?
Not sure if, as an alternative, the string array containing sUnInstallString... can be passed as a parameter within the above fixture, albeit the return type as array appears to fit a little better.

The GetUninstallString is used twice in the code.
In IsUpgrade
and in UnInstallOldVersion.
In IsUpgrade it's only tested for non-empty value.
In UnInstallOldVersion it is executed.
So make the function return whole UninstallString as a simple string.
For IsUpgrade it is enough.
And do the actual parsing to program path and its arguments in the UnInstallOldVersion only.
Also you should:
Handle a situation where there's no space in the string (no parameters)
The path to the uninstaller can contain spaces too (and it typically will as the uninstallers tend to be in Program Files).

Related

Geting SQL Server instances names from registry

I have tried to get my SQLServer instances names from the registry by using this code:
type
TRegistryHelper = class helper for TRegistry
public
function ReadMultiSz(const name: string; var Strings: TStrings): boolean;
end;
function TRegistryHelper.ReadMultiSz(const name: string;
var Strings: TStrings): boolean;
var
iSizeInByte: integer;
Buffer: array of WChar;
iWCharsInBuffer: integer;
z: integer;
sString: string;
begin
iSizeInByte := GetDataSize(name);
if iSizeInByte > 0 then begin
SetLength(Buffer, Floor(iSizeInByte / sizeof(WChar)));
iWCharsInBuffer := Floor(ReadBinaryData(name, Buffer[0], iSizeInByte) / sizeof(WChar));
sString := '';
for z := 0 to iWCharsInBuffer do begin
if Buffer[z] <> #0 then begin
sString := sString + Buffer[z];
end else begin
if sString <> '' then begin
Strings.Append(sString);
sString := '';
end;
end;
end;
result := true;
end else begin
result := false;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
cKey = '\SOFTWARE\Microsoft\Microsoft SQL Server';
var
Registry: TRegistry;
MyList: TStrings;
begin
Registry := TRegistry.Create;
Registry.RootKey := HKEY_LOCAL_MACHINE;
if Registry.OpenKeyReadOnly(cKey) then
try
MyList := TStringList.Create();
Registry.ReadMultiSz('InstalledInstances', MyList);
ListBox1.Items.Assign(MyList);
finally
MyList.Free;
end;
Registry.Free;
end;
But I have noted the iSizeInByte = -1 every time, and I failed to get those names by this way.
Also, I have noted that when trying to get those instances from my TADOQuery connection string builder, the component also failed to get those names.
Is there any way to get them?

TurboPowern OnGuard create license file with machine modifier

I use TurboPower onGuard for licensing and there is an option to specify and generate the machine specific keys for license validation. With following code I create machine modifier based on machineID
const
Ckey :TKey = ($56,$1B,$B0,$48,$2D,$AF,$F4,$E5,$30,$6C,$E5,$3B,$A7,$8E,$1A,$14);
procedure TForm1.FormCreate(Sender: TObject);
var
InfoSet : TEsMachineInfoSet;
MachineID : Longint;
begin
{ initialize the machine information set }
InfoSet := [midUser, midSystem, midNetwork, midDrives];
{ create the machine ID and display in hex }
try
MachineID := CreateMachineID(InfoSet);
Edit1.Text := '$' + BufferToHex(MachineID, SizeOf(MachineID));
except on E:Exception do
ShowMessage(E.Message);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
modifier :LongInt;
key :TKey;
releasecode,unlockcode :TCode;
inexpirydate: TdateTime;
begin
modifier := GenerateMachineModifierPrim ;
ApplyModifierToKeyPrim(Modifier, CKey, SizeOf(CKey));
//HexToBuffer(Ckey, key, SizeOf(TKey));
InitRegCode(Ckey, edit1.Text, inExpiryDate, releaseCode);
Edit2.text := BufferToHex(unlockCode, SizeOf(releaseCode));
end;
On the other hand to validate serial number and relase code I use the following code on client side to validate application, I place SerialNumberCode component to implement that.
Ckey :TKey = ($56,$1B,$B0,$48,$2D,$AF,$F4,$E5,$30,$6C,$E5,$3B,$A7,$8E,$1A,$14);
procedure TForm1.OgSerialNumberCode1GetKey(Sender: TObject; var Key: TKey);
begin
Key := Ckey;
end;
procedure TForm1.OgSerialNumberCode1GetModifier(Sender: TObject;
var Value: LongInt);
begin
Value := GenerateMachineModifierPrim;
end;
function TForm1.GetSNData(var S: string): integer;
var
TC : TCode;
SNC : string;
modifier :LOngInt;
begin
try
modifier := GenerateMachineModifierPrim;
ApplyModifierToKeyPrim(Modifier, CKey, SizeOf(CKey));
IniSNVal := StrToInt(InputBox('Serial number', 'Enter serial Value ', '12345678'));
SNC := (InputBox('release code', 'Enter code ', ''));
{Check that Release Code was entered correctly}
HexToBuffer(SNC, TC, SizeOf(TCode));
if not (IsSerialNumberCodeValid(CKey, TC)) then begin
S := 'Release code not entered correctly';
Result := mrCancel;
end else begin
IniFile := TIniFile.Create(TheDir + 'test.INI');
try
IniFile.WriteInteger('Codes', 'SN', IniSNVal);
IniFile.WriteString('Codes', 'SNCode', SNC);
finally
IniFile.Free;
end;
end;
finally
end;
end;
procedure TForm1.OgSerialNumberCode1GetCode(Sender: TObject; var Code: TCode);
var
S1 : string;
L : integer;
begin
if not (FileExists(TheDir + 'test.INI')) then
Exit;
{open Ini File}
IniFile := TIniFile.Create(TheDir + 'test.INI');
try
{try to read release code}
S1 := IniFile.ReadString('Codes', 'SNCode', '');
IniSNVal := IniFile.ReadInteger('Codes', 'SN', 0);
{convert retrieved string to a code}
HexToBuffer(S1, Code, SizeOf(Code));
finally
IniFile.Free;
end;
end;
procedure TForm1.OgSerialNumberCode1Checked(Sender: TObject; Status: TCodeStatus);
var
S,
C1,
C2 : string;
TC : TCode;
LI : longint;
begin
case Status of
ogValidCode : begin
{check if retrieved Serial Number matches Code}
LI := OgSerialNumberCode1.GetValue;
if (LI <> IniSNVal) then begin
Status := ogInvalidCode;
S := 'The serial number has been changed';
end else begin
ShowMessage('Serial #: ' + IntToStr(IniSNVal));
Exit;
end;
end;
ogInvalidCode : begin
{if INI file doesn't exist, presume this is first run}
if not (FileExists(TheDir + 'test.INI')) then
begin
if not (GetSNData(S) = mrCancel) then begin
{Check the SN/ReleaseCode}
OgSerialNumberCode1.CheckCode(True);
{must Exit since line above began a recursive call}
Exit;
end;
end else
S := 'Invalid Code';
end;
ogCodeExpired : S := 'Evaluation period expired';
end;
ShowMessage(S);
Application.Terminate;
end;
But at the client side machine never accepts the validation and throws Release code not entered correctly. Probably I don't understand usage of machineID exmaple in onguard folder. Please also note that the key for client side and generation for relaease code is same so there shouldn't be any mismatch.

open multiple files via shell context menu as params

I want to select more than one text file in the windows explorer and open the files via context menu in my app. For one file I found the solution but for more files there some ideas but no (working) solutions.
Anyone here that has the answer?
Here is an example that i've just searched and collected from internet.
Aim: Select multiple folders in Windows Explorer and get list of these folders' names via a shell context menu item "SelectedFolders", or using SendTo menu or drag-and-drop folders from shell onto the application form.
Please put a listbox named lstSelectedFolders and a speed button named sbClearList.
The main form name is frmSelectedFolders.
Here we go.
/////////////////////////////////////////////////////////////
program selectedfolders;
uses
Windows, Messages, SysUtils, Forms,
uSelectedFolders in 'uSelectedFolders.pas' {frmSelectedFolders};
{$R *.res}
var
receiver: THandle;
i, result: integer;
s: string;
dataToSend: TCopyDataStruct;
Mutex : THandle;
begin
Mutex := CreateMutex(nil, True, 'SelectedFolders');
if (Mutex <> 0) and (GetLastError = 0) then
begin
Application.Initialize;
Application.Title := 'Selected Folders';
Application.CreateForm(TfrmSelectedFolders, frmSelectedFolders);
Application.Run;
if Mutex <> 0 then CloseHandle(Mutex);
end
else
begin
receiver := FindWindow(PChar('TfrmSelectedFolders'), PChar('Selected Folders'));
if receiver <> 0 then
begin
for i:=1 to ParamCount do
begin
s := trim(ParamStr(i));
if s <> '' then
begin
dataToSend.dwData := 0;
dataToSend.cbData := 1 + Length(s);
dataToSend.lpData := PChar(s);
result := SendMessage(receiver, WM_COPYDATA, Integer(Application.Handle), Integer(#dataToSend));
//sleep(100);
//if result > 0 then
// ShowMessage(Format('Sender side: Receiver has %d items in list!', [result]));
end;
end; // for i
end;
end;
end.
/////////////////////////////////////////////////////////////
unit uSelectedFolders;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI, ActiveX, ComObj, ShlObj, Registry, Buttons;
type
TfrmSelectedFolders = class(TForm)
lstSelectedFolders: TListBox;
sbClearList: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure sbClearListClick(Sender: TObject);
private { Private declarations }
public { Public declarations }
procedure WMDROPFILES(var Message: TWMDROPFILES); message WM_DROPFILES;
procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA;
function GetTarget(const LinkFileName: string): string;
end;
var
frmSelectedFolders: TfrmSelectedFolders;
implementation
{$R *.dfm}
procedure RegisterContextMenuForFolders();
const
Key = 'Directory\shell\SelectedFolders\command\';
begin
with TRegistry.Create do
try
// for all users, class registration for directories
RootKey := HKEY_CLASSES_ROOT;
if OpenKey(Key, true) then
WriteString('', '"' + Application.ExeName + '" "%l"');
finally
Free;
end;
end;
procedure TfrmSelectedFolders.WMDROPFILES(var Message: TWMDROPFILES);
var
N, i: integer;
buffer: array[0..255] of Char;
s: string;
begin
try
N := DragQueryFile(Message.Drop, $FFFFFFFF, nil, 0);
for i:=1 to N do
begin
DragQueryFile(Message.Drop, i-1, #buffer, SizeOf(buffer));
s := buffer;
if UpperCase(ExtractFileExt(s)) = '.LNK' then
s := GetTarget(s);
if lstSelectedFolders.Items.IndexOf(s) < 0 then
lstSelectedFolders.Items.Add(s);
end;
finally
DragFinish(Message.Drop);
end;
end;
function TfrmSelectedFolders.GetTarget(const LinkFileName: string): string;
var
//Link : String;
psl : IShellLink;
ppf : IPersistFile;
WidePath : Array[0..260] of WideChar;
Info : Array[0..MAX_PATH] of Char;
wfs : TWin32FindData;
begin
if UpperCase(ExtractFileExt(LinkFileName)) <> '.LNK' then
begin
Result := 'NOT a shortuct by extension!';
Exit;
end;
CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, psl);
if psl.QueryInterface(IPersistFile, ppf) = 0 Then
Begin
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, PChar(LinkFileName), -1, #WidePath, MAX_PATH);
ppf.Load(WidePath, STGM_READ);
psl.GetPath(#info, MAX_PATH, wfs, SLGP_UNCPRIORITY);
Result := info;
end
else
Result := '';
end;
procedure TfrmSelectedFolders.WMCopyData(var Msg: TWMCopyData);
var
s: string;
begin
s := trim(PChar(Msg.copyDataStruct.lpData));
if s = '' then
begin
msg.Result := -1;
exit;
end;
if UpperCase(ExtractFileExt(s)) = '.LNK' then
s := GetTarget(s);
if lstSelectedFolders.Items.IndexOf(s) < 0 then
lstSelectedFolders.Items.Add(s);
msg.Result := lstSelectedFolders.Items.Count;
end;
procedure TfrmSelectedFolders.FormCreate(Sender: TObject);
var
i: integer;
s: string;
begin
RegisterContextMenuForFolders();
DragAcceptFiles(Handle, TRUE);
lstSelectedFolders.Clear;
s := ExtractFileDir(Application.ExeName);
lstSelectedFolders.Items.Add(s);
for i:=1 to ParamCount do
begin
s := trim(ParamStr(i));
if UpperCase(ExtractFileExt(s)) = '.LNK' then
s := GetTarget(s);
if lstSelectedFolders.Items.IndexOf(s) < 0 then
lstSelectedFolders.Items.Add(s);
end;
end;
procedure TfrmSelectedFolders.sbClearListClick(Sender: TObject);
begin
lstSelectedFolders.Clear;
end;
end.

Local string array initialization

I have sporadic problems (access violation in unit System).
Application is running 24 x 7 and it happens one - two times in a week.
I have a procedure with local string array, and I found there are cases I assign non initialised array member to string variable like in code below.
Could it be a reason for access violation?
procedure tform1.DoSomething;
var
sarr: array [1..4] of String;
s: String;
begin
sarr[1] := 'aaaa';
sarr[2] := 'bbbb';
s := sarr[3]; // Can I get here an access violation???
end;
Real function code below
exception happens when obj.opcode = cmdp_done
function is called from thread message queue. obj is created in another thread, and
sent in PostThreadMessage as msg.lparam
procedure ORTR_ProcessFiscalResponse(obj: TDataForOrpak);
const
maxdim = 4;
var
s: array [1..maxdim] of String;
i, n, fiscalNr, statusToSend: Integer;
sql, pdf, ortrName, docType, rut: String;
ortr: TCustomizedOrtr;
oFiscal: TFiscalDevice;
fpds: TFPDeviceState;
begin
try
case obj.opcode of
cmdp_status: N := 3;
cmdp_done: N := 2;
plcl_docissued: N := 4;
plcl_docfailed: N := 1;
else
Exit;
end;
for i:=1 to n do
s[i] := GetTerm(obj.ident, i, ';');
if s[1] = '' then
Exit;
statusToSend := 0;
ortrName := GetTerm(s[1], 1, '+');
fiscalNr := StrToIntDef(GetTerm(s[1]+'+', 2, '+'), 999999);
docType := s[3];
rut := s[4];
ortr := TCustomizedOrtr.GetTerminalByName(ortrName) as TCustomizedOrtr;
if ortr = nil then
Exit;
if (ortr.FPState = fps_idle) or (ortr.fiscalNr <> fiscalNr) then begin
if (StrToIntDef(s[2], 0) <> 0) and (obj.opcode = cmdp_done) then
fiscal_Confirm(obj.otherdevname, obj.ident);
if obj.opcode = plcl_docissued then begin
try
PLCL_SetDocState(s[1], rut, false, StrToInt(s[2]), StrToInt(docType));
except
AddToLogFile('*** PLCL_SetDocState', log_exceptions);
end;
end;
Exit;
end;
oFiscal := fiscal_Assigned(ortr.ctlPump.PumpID) as TFiscalDevice;
case obj.opcode of
plcl_docissued:
begin
ortr.authData.ECRReceiptNr := s[2];
pdf := StringFromHexPresentation(obj.rawdata);
sql := format(sql_PaperlessAdd, [
ToLocalSQL_DateTime(ortr.ctlPump.FinalTime),
ToLocalSQL_Integer(ortr.ctlPump.PumpID),
ToLocalSQL_String(pdf)]);
try
UpdateLocalDB(sql);
except
AddToLogFile('*** PL save pdf', log_exceptions);
end;
try
PLCL_SetDocState(s[1], rut, true, StrToInt(s[2]), StrToInt(docType));
except
AddToLogFile('*** PLCL_SetDocState', log_exceptions);
end;
ortr.FPState := fps_idle;
ortr.currStage := TTextIndexType(0);
ortr.currStage := tivirt_towelcome; // VADIM
ExternalProcessPumpState(ortr.authData.gsPump.PumpID);
end;
plcl_docfailed:
ortr.FPState := fps_plerror;
cmdp_status:
begin
ortr.FPError := StrToIntDef(s[3], 0);
fpds := TFPDeviceState(StrToIntDef(s[2], 0));
ortr.FPState := fpds;
if (fpds in [fps_nocomm, fps_error]) and (ortr.fiscalMode = 1) and
(ortr.authData = nil) and (ortr.fiscalNr < 0) then
SpecialInterface.SendFiscalNrToPromax(-ortr.fiscalNr, '0');
case fpds of
fps_nopaper: statusToSend := wph_prnpaperout;
fps_nocomm: statusToSend := wph_prncommfailure;
fps_error: statusToSend := wph_prngenericfailure;
end;
end;
cmdp_done:
begin
if ortr.fiscalMode = 1 then begin
if ortr.authData = nil then begin // DRY GOOD
SpecialInterface.SendFiscalNrToPromax(-fiscalNr, s[2]);
end
else begin
ortr.authData.ECRReceiptNr := s[2];
ExternalProcessPumpState(ortr.authData.gsPump.PumpID);
end
end;
if StrToIntDef(s[2], 0) <> 0 then
fiscal_Confirm(obj.otherdevname, obj.ident);
statusToSend := wph_prnidle;
ortr.FPState := fps_idle;
ortr.currStage := ti_takereceipt;
end;
end;
if (statusToSend <> 0) and (oFiscal <> nil) then
PostNonVisualCommand(nv_devicestate, statusToSend, Integer(oFiscal));
finally
obj.free;
end;
end;
Your initial piece of code, the tform1.DoSomething routine, is unable of producing an access violation:
For the static array variable sarr, memory is allocated for all its elements.
The string variable s, as well as the elements in sarr, are automatically initialized to empty. 1
Thus you are simply assigning an empty string, and s remains empty.
Concerning your actual code, assuming that it does produce the access violation, my guess would be that:
the obj parameter still refers to an already destroyed object,
that obj.opcode reads an invalid piece of memory, but since it is compared to an numerical value, will pass,
that Exit is called in de case else clause, and
that obj.Free fails in the finally clause.
1 All string variables are initilized to empty, except string function results:
If the function exits without assigning a value to Result or the function name, then the function's return value is undefined.
The missing compiler warning is still a bug.

Delphi Boolean Return Function Hint: Value assigned to '' never used?

I have
playerIds : Array[0..500] of string;
function isPlayerMob(check : string): boolean;
var
i : integer;
begin
for i := 0 to 500 do
begin
if ((playerIds[i] <> '') and (playerIds[i] = check)) then
begin
result := true;
end;
end;
result := false;
end;
I get the Warning
Hint: Value assigned to 'isPlayerMob' never used
Can somebody tell me how to fix this?
The error is for the
result := true;
As others have told you, the value your loop is assigning to Result is being discarded because you are not exiting the function before the final assignment to Result, so it does not matter what the loop assigns.
You could assign the Result with an initial value and then reassign it as needed, or you could simply Exit after you have assigned your desired value:
function isPlayerMob(check : string): boolean;
var
i : integer;
begin
for i := 0 to 500 do
begin
if ((playerIds[i] <> '') and (playerIds[i] = check)) then
begin
Result := True;
Exit; // <-- add this
end;
end;
Result := False; // <-- only performed if the loop does not find a match
end;
Or, if you are using a recent Delphi version:
function isPlayerMob(check : string): boolean;
var
i : integer;
begin
for i := 0 to 500 do
begin
if ((playerIds[i] <> '') and (playerIds[i] = check)) then
Exit(True); // <-- sets Result and exits at the same time
end;
Result := False; // <-- only performed if the loop does not find a match
end;
This hint is because your always are assigning the false value to the function. no matter if the value if found in the loop.
try this
function isPlayerMob(const check : string): boolean;
var
i : integer;
begin
result := false;
for i := 0 to 500 do
if ((playerIds[i] <> '') and (playerIds[i] = check)) then
begin
result := true;
break;
end;
end;
Your function as written will always execute the final Result := false; line, and therefore the value assigned inside the loop will always be discarded.
Change your function instead to initialize the result first:
function isPlayerMob(check : string): boolean;
var
i : integer;
begin
Result := false;
for i := 0 to 500 do
begin
if ((playerIds[i] <> '') and (playerIds[i] = check)) then
begin
Result := true;
Exit;
end;
end;
end;
In Delphi 2009 and higher, the Result := True; Exit; lines can be replaced with simply Exit(True); instead.

Resources