Unknown identifier and wpSelectDir - service
I have an error that's occuring during the compliation of my Inno Setup script.
Unknown identifier 'PathOfDir2'
I know I can set var PathOfDir2: String; but i don't know where and if it will receive the value from my wpSelectDir.
Dooes anyone know what's going wrong?
[code]
// Variables Globales
var
TimeZone: String;
type
SERVICE_STATUS = record
dwServiceType : cardinal;
dwCurrentState : cardinal;
dwControlsAccepted : cardinal;
dwWin32ExitCode : cardinal;
dwServiceSpecificExitCode : cardinal;
dwCheckPoint : cardinal;
dwWaitHint : cardinal;
end;
HANDLE = cardinal;
const
SERVICE_QUERY_CONFIG = $1;
SERVICE_CHANGE_CONFIG = $2;
SERVICE_QUERY_STATUS = $4;
SERVICE_START = $10;
SERVICE_STOP = $20;
SERVICE_ALL_ACCESS = $f01ff;
SC_MANAGER_ALL_ACCESS = $f003f;
SERVICE_WIN32_OWN_PROCESS = $10;
SERVICE_WIN32_SHARE_PROCESS = $20;
SERVICE_WIN32 = $30;
SERVICE_INTERACTIVE_PROCESS = $100;
SERVICE_BOOT_START = $0;
SERVICE_SYSTEM_START = $1;
SERVICE_AUTO_START = $2;
SERVICE_DEMAND_START = $3;
SERVICE_DISABLED = $4;
SERVICE_DELETE = $10000;
SERVICE_CONTROL_STOP = $1;
SERVICE_CONTROL_PAUSE = $2;
SERVICE_CONTROL_CONTINUE = $3;
SERVICE_CONTROL_INTERROGATE = $4;
SERVICE_STOPPED = $1;
SERVICE_START_PENDING = $2;
SERVICE_STOP_PENDING = $3;
SERVICE_RUNNING = $4;
SERVICE_CONTINUE_PENDING = $5;
SERVICE_PAUSE_PENDING = $6;
SERVICE_PAUSED = $7;
// #######################################################################################
// nt based service utilities
// #######################################################################################
function OpenSCManager(lpMachineName, lpDatabaseName: string; dwDesiredAccess :cardinal): HANDLE;
external 'OpenSCManagerA#advapi32.dll stdcall';
function OpenService(hSCManager :HANDLE;lpServiceName: string; dwDesiredAccess :cardinal): HANDLE;
external 'OpenServiceA#advapi32.dll stdcall';
function CloseServiceHandle(hSCObject :HANDLE): boolean;
external 'CloseServiceHandle#advapi32.dll stdcall';
function CreateService(hSCManager :HANDLE;lpServiceName, lpDisplayName: string;dwDesiredAccess,dwServiceType,dwStartType,dwErrorControl: cardinal;lpBinaryPathName,lpLoadOrderGroup: String; lpdwTagId : cardinal;lpDependencies,lpServiceStartName,lpPassword :string): cardinal;
external 'CreateServiceA#advapi32.dll stdcall';
function DeleteService(hService :HANDLE): boolean;
external 'DeleteService#advapi32.dll stdcall';
function StartNTService(hService :HANDLE;dwNumServiceArgs : cardinal;lpServiceArgVectors : cardinal) : boolean;
external 'StartServiceA#advapi32.dll stdcall';
function ControlService(hService :HANDLE; dwControl :cardinal;var ServiceStatus :SERVICE_STATUS) : boolean;
external 'ControlService#advapi32.dll stdcall';
function QueryServiceStatus(hService :HANDLE;var ServiceStatus :SERVICE_STATUS) : boolean;
external 'QueryServiceStatus#advapi32.dll stdcall';
function QueryServiceStatusEx(hService :HANDLE;ServiceStatus :SERVICE_STATUS) : boolean;
external 'QueryServiceStatus#advapi32.dll stdcall';
function OpenServiceManager() : HANDLE;
begin
if UsingWinNT() = true then
begin
Result := OpenSCManager('','ServicesActive',SC_MANAGER_ALL_ACCESS);
if Result = 0 then
MsgBox('the servicemanager is not available', mbError, MB_OK)
end
else
begin
MsgBox('only nt based systems support services', mbError, MB_OK)
Result := 0;
end
end;
function IsServiceInstalled(ServiceName: string) : boolean;
var
hSCM : HANDLE;
hService: HANDLE;
begin
hSCM := OpenServiceManager();
Result := false;
if hSCM <> 0 then begin
hService := OpenService(hSCM,ServiceName,SERVICE_QUERY_CONFIG);
if hService <> 0 then begin
Result := true;
CloseServiceHandle(hService)
end;
CloseServiceHandle(hSCM)
end
end;
function InstallService(FileName, ServiceName, DisplayName, Description : string;ServiceType,StartType :cardinal) : boolean;
var
hSCM : HANDLE;
hService: HANDLE;
begin
hSCM := OpenServiceManager();
Result := false;
if hSCM <> 0 then begin
hService := CreateService(hSCM,ServiceName,DisplayName,SERVICE_ALL_ACCESS,ServiceType,StartType,0,FileName,'',0,'','','');
if hService <> 0 then begin
Result := true;
// Win2K & WinXP supports aditional description text for services
if Description<> '' then
RegWriteStringValue(HKLM,'System\CurrentControlSet\Services' + ServiceName,'Description',Description);
CloseServiceHandle(hService)
end;
CloseServiceHandle(hSCM)
end
end;
function RemoveService(ServiceName: string) : boolean;
var
hSCM : HANDLE;
hService: HANDLE;
begin
hSCM := OpenServiceManager();
Result := false;
if hSCM <> 0 then begin
hService := OpenService(hSCM,ServiceName,SERVICE_DELETE);
if hService <> 0 then begin
Result := DeleteService(hService);
CloseServiceHandle(hService)
end;
CloseServiceHandle(hSCM)
end
end;
function StartService(ServiceName: string) : boolean;
var
hSCM : HANDLE;
hService: HANDLE;
begin
hSCM := OpenServiceManager();
Result := false;
if hSCM <> 0 then begin
hService := OpenService(hSCM,ServiceName,SERVICE_START);
if hService <> 0 then begin
Result := StartNTService(hService,0,0);
CloseServiceHandle(hService)
end;
CloseServiceHandle(hSCM)
end;
end;
function StopService(ServiceName: string) : boolean;
var
hSCM : HANDLE;
hService: HANDLE;
Status : SERVICE_STATUS;
begin
hSCM := OpenServiceManager();
Result := false;
if hSCM <> 0 then begin
hService := OpenService(hSCM,ServiceName,SERVICE_STOP);
if hService <> 0 then begin
Result := ControlService(hService,SERVICE_CONTROL_STOP,Status);
CloseServiceHandle(hService)
end;
CloseServiceHandle(hSCM)
end;
end;
function IsServiceRunning(ServiceName: string) : boolean;
var
hSCM : HANDLE;
hService: HANDLE;
Status : SERVICE_STATUS;
begin
hSCM := OpenServiceManager();
Result := false;
if hSCM <> 0 then begin
hService := OpenService(hSCM,ServiceName,SERVICE_QUERY_STATUS);
if hService <> 0 then begin
if QueryServiceStatus(hService,Status) then begin
Result :=(Status.dwCurrentState = SERVICE_RUNNING)
end;
CloseServiceHandle(hService)
end;
CloseServiceHandle(hSCM)
end
end;
// #######################################################################################
// create an entry in the services file
// #######################################################################################
function SetupService(service, port, comment: string) : boolean;
var
filename : string;
s : string;
lines : TArrayOfString;
n : longint;
i : longint;
errcode : integer;
servnamlen : integer;
error : boolean;
begin
if UsingWinNT() = true then
filename := ExpandConstant('{sys}\drivers\etc\services')
else
filename := ExpandConstant('{win}\services');
if LoadStringsFromFile(filename,lines) = true then begin
Result := true;
n := GetArrayLength(lines) - 1;
servnamlen := Length(service);
error := false;
for i:=0 to n do begin
if Copy(lines[i],1,1) <> '#' then begin
s := Copy(lines[i],1,servnamlen);
if CompareText(s,service) = 0 then
exit; // found service-entry
if Pos(port,lines[i]) > 0 then begin
error := true;
lines[i] := '#' + lines[i] + ' # disabled because collision with ' + service + ' service';
end;
end
else if CompareText(Copy(lines[i],2,servnamlen),service) = 0 then begin
// service-entry was disabled
Delete(lines[i],1,1);
Result := SaveStringsToFile(filename,lines,false);
exit;
end;
end;
if error = true then begin
// save disabled entries
if SaveStringsToFile(filename,lines,false) = false then begin
Result := false;
exit;
end;
end;
// create new service entry
s := service + ' ' + port + ' # ' + comment + #13#10;
if SaveStringToFile(filename,s,true) = false then begin
Result := false;
exit;
end;
if error = true then begin
MsgBox('the ' + service + ' port was already used. The old service is disabled now. You should check the services file manually now.',mbInformation,MB_OK);
//InstExec('notepad.exe',filename,GetCurrentDir(),true,false,SW_SHOWNORMAL,errcode);
end;
end
else
Result := false;
end;
// #######################################################################################
// version functions
// #######################################################################################
function CheckVersion(Filename : string;hh,hl,lh,ll : integer) : boolean;
var
VersionMS : cardinal;
VersionLS : cardinal;
CheckMS : cardinal;
CheckLS : cardinal;
begin
if GetVersionNumbers(Filename,VersionMS,VersionLS) = false then
Result := false
else begin
CheckMS := (hh shl $10) or hl;
CheckLS := (lh shl $10) or ll;
Result := (VersionMS > CheckMS) or ((VersionMS = CheckMS) and (VersionLS >= CheckLS));
end;
end;
// Some examples for version checking
function NeedShellFolderUpdate() : boolean;
begin
Result := CheckVersion('ShFolder.dll',5,50,4027,300) = false;
end;
function NeedVCRedistUpdate() : boolean;
begin
Result := (CheckVersion('mfc42.dll',6,0,8665,0) = false)
or (CheckVersion('msvcrt.dll',6,0,8797,0) = false)
or (CheckVersion('comctl32.dll',5,80,2614,3600) = false);
end;
function NeedHTMLHelpUpdate() : boolean;
begin
Result := CheckVersion('hh.exe',4,72,0,0) = false;
end;
function NeedWinsockUpdate() : boolean;
begin
Result := (UsingWinNT() = false) and (CheckVersion('mswsock.dll',4,10,0,1656) = false);
end;
function NeedDCOMUpdate() : boolean;
begin
Result := (UsingWinNT() = false) and (CheckVersion('oleaut32.dll',2,30,0,0) = false);
end;
// #######################################################################################
// Replace substring in a string functions
// #######################################################################################
procedure FileReplace(SrcFile, sFrom, sTo: String);
var
FileContent: String;
begin
//Load srcfile to a string
LoadStringFromFile(SrcFile, FileContent);
//Replace Fraomstring by toString in file string content
StringChange (sTo,'/', '\');
StringChange (FileContent, sFrom, sTo);
//Replace old content srcfile by the new content
DeleteFile(SrcFile);
SaveStringToFile(SrcFile,FileContent, True);
end;
// #######################################################################################
// Replace in file functions
// #######################################################################################
procedure FileWrite(SrcFile, sFrom, sTo: String);
var
FileContent: String;
begin
//Load srcfile to a string
LoadStringFromFile(SrcFile, FileContent);
//Replace Fraomstring by toString in file string content
//StringChange (sTo,'/', '\');
StringChange (FileContent, sFrom, sTo);
//Replace old content srcfile by the new content
DeleteFile(SrcFile);
SaveStringToFile(SrcFile,FileContent, True);
end;
// #######################################################################################
// Custumized page for apache config
// #######################################################################################
procedure CreateTheWizardPages;
// variables locales
var
Lbl: TLabel;
Page: TWizardPage;
Edit: TEdit;
PortNbr: String;
// boites
begin
Page := CreateCustomPage(wpSelectComponents, 'Apache configuration', 'Please enter your parameter for the apache server (Default is 80)');
Lbl := TLabel.Create(Page);
Lbl.Top := ScaleY(11);
Lbl.Caption := 'Apache server port :';
Lbl.AutoSize := True;
Lbl.Parent := Page.Surface;
Edit := TEdit.Create(Page);
Edit.Top := ScaleY(8);
Edit.Left := Lbl.Left + ScaleX(70);
Edit.Width := Page.SurfaceWidth div 2 - ScaleX(8);
Edit.Text := PortNbr;
Edit.Text := '80';
Edit.Parent := Page.Surface;
end;
// #######################################################################################
// Custumized page for Password enter
// #######################################################################################
procedure CreateTheWizardPagesPwd;
// variables locales
var
PasWd: TLabel;
PagePwd: TWizardPage;
EditPw: TEdit;
//MailHostName: String;
// boites
begin
PagePwd := CreateCustomPage(wpSelectComponents, 'Password for the data base user', 'Please enter the password for the data base');
PasWd := TLabel.Create(PagePwd);
PasWd.Top := ScaleY(11);
PasWd.Caption := 'PassWord : ';
PasWd.AutoSize := True;
PasWd.Parent := PagePwd.Surface;
EditPw := TEdit.Create(PagePwd);
EditPw.Top := ScaleY(8);
EditPw.Left := PasWd.Left + ScaleX(70);
EditPw.Width := PagePwd.SurfaceWidth div 2 - ScaleX(8);
EditPw.Parent := PagePwd.Surface;
end;
// #######################################################################################
// Custumized page for Enter the path of the backup file
// #######################################################################################
procedure CreateTheWizardPagesBkpDir;
var
PageBkpDir: TInputDirWizardPage;
// boites
begin
PageBkpDir := CreateInputDirPage(wpSelectDir,'Select Backup Data Directory','Where should Backup data files be installed?','Select the folder in which Setup should copy backup data files, then click Next.', False, '');
PageBkpDir.Add('');
PageBkpDir.Values[0] := ExpandConstant('{userdesktop}\dbBackup');
end;
// #######################################################################################
// Custumized page for Time zone enter
// #######################################################################################
procedure CreateTheWizardPagesTimeZone;
// variables locales
var
Panel: TPanel;
PageTimeZone: TWizardPage;
ListBTimeZone: TNewListBox;
// boites
begin
PageTimeZone := CreateCustomPage(wpWelcome, 'Time zone of your location', 'Please choose your time zone');
Panel := TPanel.Create(PageTimeZone);
Panel.Width := PageTimeZone.SurfaceWidth div 2 - ScaleX(8);
Panel.Left := PageTimeZone.SurfaceWidth - Panel.Width;
Panel.Caption := 'TPanel';
Panel.Color := clWindow;
Panel.ParentBackground := False;
Panel.Parent := PageTimeZone.Surface;
ListBTimeZone := TNewListBox.Create(PageTimeZone);
ListBTimeZone.Width := PageTimeZone.SurfaceWidth;
ListBTimeZone.Height := ScaleY(200);
ListBTimeZone.Parent := PageTimeZone.Surface;
ListBTimeZone.Items.Add('Etc/UTC');
ListBTimeZone.Items.Add('Europe/Paris');
ListBTimeZone.ItemIndex := 2;
end;
// Initialisation
procedure InitializeWizard();
begin
CreateTheWizardPages;
CreateTheWizardPagesTimeZone;
CreateTheWizardPagesPwd;
CreateTheWizardPagesBkpDir;
end;
// #######################################################################################
// Function to stop and delete de service by uninstallation procedur
// #######################################################################################
procedure CurUninstallStepChanged(CurStep: TUninstallStep);
var
ErrorCode: Integer;
begin
if CurStep = usUninstall then
begin
//Uninstall process
ShellExec('open','taskkill.exe','/f /im MyApplicationService.exe','',SW_HIDE,ewNoWait,ErrorCode);
ShellExec('open','taskkill.exe','/f /im httpd.exe','',SW_HIDE,ewNoWait,ErrorCode);
ShellExec('open','taskkill.exe','/f /im mysqld.exe','',SW_HIDE,ewNoWait,ErrorCode);
// stop all affected services
StopService('MyApplicationService');
StopService('MySqld');
StopService('Apache');
// remove all affected services
RemoveService('MyApplicationService');
RemoveService('MySqld');
RemoveService('Apache');
end;
end;
// #######################################################################################
// Function to check and replace the string in the file at the end of the installation
// #######################################################################################
procedure CurStepChanged(CurStep: TSetupStep);
var
ErrorCode: Integer;
WorkingDir: String;
PathOfDir: String;
begin
//juste aprés installation
if CurStep = ssPostInstall then
begin
PathOfDir := GetShortName(PathOfDir2);
FileReplace(ExpandConstant('{app}\create_db.sql'), '##Pwd##', EditPw.Text);
FileReplace(ExpandConstant('{app}\webserver\bin\apache\Apache2.2.22\conf\httpd.conf'), '##Port##', PortNbr);
FileReplace(ExpandConstant('{app}\webserver\bin\apache\Apache2.2.22\conf\httpd.conf'), '##Path##', PathOfDir+'\webserver');
FileReplace(ExpandConstant('{app}\webserver\bin\apache\Apache2.2.22\bin\php.ini'), '##Path##', PathOfDir+'\webserver');
FileWrite(ExpandConstant('{app}\webserver\bin\apache\Apache2.2.22\bin\php.ini'), '##TimeZone##', TimeZone);
FileReplace(ExpandConstant('{app}\webserver\bin\mysql\mysql5.5.24\my.ini'), '##Path##', PathOfDir+'\webserver');
FileReplace(ExpandConstant('{app}\webserver\bin\mysql\mysql5.5.24\bin\dbexport.bat'), '##Path##', PathOfBackupDir);
FileReplace(ExpandConstant('{app}\webserver\bin\mysql\mysql5.5.24\bin\create_db.bat'), '##Path##', PathOfDir + '\webserver\bin\mysql\mysql5.5.24');
FileReplace(ExpandConstant('{app}\webserver\bin\mysql\mysql5.5.24\bin\create_db.bat'), '##PathOfDir##', PathOfDir);
FileReplace(ExpandConstant('{app}\webserver\bin\php\php5.4.3\php.ini'), '##Path##', PathOfDir+'\webserver');
FileReplace(ExpandConstant('{app}\webserver\bin\php\php5.4.3\phpForApache.ini'), '##Path##', PathOfDir+'\webserver');
if InstallService(ExpandConstant('"{app}\webserver\bin\mysql\mysql5.5.24\bin\mysqld.exe" MySqld'),'MySqld','MySqld','The mysql service',SERVICE_WIN32_OWN_PROCESS,SERVICE_AUTO_START) = true then
begin
StartService('MySqld');
Sleep(8000);
end
else
MsgBox('MySqld service could not be installed',mbInformation, MB_OK);
if InstallService(ExpandConstant('"{app}\webserver\bin\apache\apache2.2.22\bin\httpd.exe" -k runservice'),'Apache','Apache','The apache service',SERVICE_WIN32_OWN_PROCESS,SERVICE_AUTO_START) = true then
begin
StartService('Apache');
Sleep(5000);
end
else
MsgBox('Apache service could not be installed',mbInformation, MB_OK);
if InstallService(ExpandConstant('"{app}\MyApplicationService.exe"'),'MyApplicationService','MyApplicationService','The server',SERVICE_WIN32_OWN_PROCESS,SERVICE_AUTO_START) = true then
begin
StartService('MyApplicationService');
Sleep(5000);
end
else
MsgBox('The MyApplicationService service could not be installed',mbInformation, MB_OK);
end;
if CurStep = ssInstall then
begin
//Uninstall process
ShellExec('open','taskkill.exe','/f /im MyApplicationService.exe','',SW_HIDE,ewNoWait,ErrorCode);
ShellExec('open','taskkill.exe','/f /im httpd.exe','',SW_HIDE,ewNoWait,ErrorCode);
ShellExec('open','taskkill.exe','/f /im mysqld.exe','',SW_HIDE,ewNoWait,ErrorCode);
// stop all affected services
StopService('MyApplicationService');
StopService('MySqld');
StopService('Apache');
// remove all affected services
RemoveService('MyApplicationService');
RemoveService('MySqld');
RemoveService('Apache');
end;
if CurStep = ssDone then
begin
Exec(ExpandConstant('{app}\webserver\bin\mysql\mysql5.5.24\bin\create_db.bat'),'','', SW_SHOW, ewWaitUntilTerminated, ErrorCode);
end;
end;
// #######################################################################################
// Function to check the values entered
// #######################################################################################
function NextButtonClick(CurPageID: Integer): Boolean;
var
ErrorCode: Integer;
begin
Result := True;
case CurPageID of
Page.ID:
begin
if (Edit.Text = '') then
begin
MsgBox('Port number check:'#13#13 'The port number is empty. The default port << 80 >> will be applied. Please click on the back button to change if needed ', mbError, MB_OK);
Edit.Text := '80';
end
else
begin
Result := True;
PortNbr := Edit.Text;
end
end;
//End page.id
PagesEmailSt.ID:
begin
if (EditPwd.Text = EditPwd2.Text) then
begin
MailHostName := EditMailHostName.Text;
MailUserName := EditUserName.Text;
MailPwd := EditPwd.Text;
MailFrom := EditFromMail.Text;
MailSmtpPort := EditSmtpPort.Text;
end
else
begin
MsgBox('Password check:'#13#13 'The password entered is not the same. Please click on back and check ', mbError, MB_OK);
Result := false;
end
end;
//End PagesEmailSt.id
//Time zone add beginn
PageTimeZone.ID:
begin
Result := false;
TimeZone := ListBTimeZone.Items.Strings[ListBTimeZone.ItemIndex];
end;
//End time zone add
//Beginn dir selector
PageBkpDir.ID:
begin
//PageBkpDir.Values[0] := ExpandConstant('{userdesktop}\dbBackup');
PathOfBackupDir := PageBkpDir.Values[0];
end;
wpSelectDir:
begin
PathOfDir2 := WizardDirValue;
//MsgBox('NextButtonClick:' #13#13 'You selected: ''' + PathOfDir + '''.', mbInformation, MB_OK);
end;
//End dir selector
end; //End case
Result := True;
end;
function GetDataDir(Param: String): String;
begin
//Return the selected DataDir
Result := PageBkpDir.Values[0];
end;
In this case, as it needs to be accessed from multiple functions, you need to make it a global variable by putting it in the top Var. You will also need to do the same with the page references/IDs.
Related
How to transform a class name string to a class object?
In a 32-bit VCL Application in Windows 10 in Delphi 11 Alexandria, I am trying to write a small app that finds the list of ANCESTORS from a class name that the user inputs in an Edit box: procedure TForm1.DoShowAncestors(const aClassName: string); var ClassRef: TClass; begin lstAncestors.Clear; // Does not work: //ClassRef := TClass.Create; //ClassRef.ClassName := aClassName; // [dcc32 Error] E2076 This form of method call only allowed for class methods or constructor: ClassRef := TClass(aClassName).ClassType; while ClassRef <> nil do begin lstAncestors.Items.Add(ClassRef.ClassName); ClassRef := ClassRef.ClassParent; end; end; procedure TForm1.edtClassNameKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then begin DoShowAncestors(Trim(edtClassName.Text)); end; end; However, the problem is to transform the input string into a TClass object. See the above error comments.
Since Delphi is a compiled language, obtaining a class (or object) by name is not a natural operation, but requires some kind of framework. Fortunately, modern RTTI (uses RTTI) can easily handle this for you: procedure ShowAncestors(const AClass: string); begin var Ctx := TRttiContext.Create; try var LType := Ctx.FindType(AClass); if LType is TRttiInstanceType then begin var R := TRttiInstanceType(LType).MetaclassType; while Assigned(R) do begin ShowMessage(R.ClassName); R := R.ClassParent; end; end; finally Ctx.Free; // actually, just to make the code "look" right! end; end; Try it with ShowAncestors('Vcl.Forms.TForm') for instance. (Of course, this only works for classes actually included in the final EXE.)
Now there is no more need to enter a fully qualified class name, and now there is a visual feedback validation of the class name in the edit: unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.Classes, Vcl.StdCtrls, Vcl.ExtCtrls; type TForm1 = class(TForm) edtClassName: TEdit; lstAncestors: TListBox; pnlEdit: TPanel; procedure edtClassNameChange(Sender: TObject); procedure edtClassNameKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure edtClassNameKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormActivate(Sender: TObject); private FDontDoIt: Boolean; function CheckEmptyEdit: Boolean; procedure DoShowAncestors(const aClassName: string); function GetMatchingTypeName: string; procedure SetEditBorder; { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses System.StrUtils, System.RTTI; function FindMyClass(const aName: string): TClass; var ctx: TRttiContext; ThisType: TRttiType; ThisList: TArray<TRttiType>; FPos: Integer; begin Result := nil; ctx := TRttiContext.Create; try ThisList := ctx.GetTypes; for ThisType in ThisList do begin if ThisType.IsInstance and (EndsText(aName, ThisType.Name)) then begin Result := ThisType.AsInstance.MetaClassType; BREAK; end; end; finally ctx.Free; end; end; procedure TForm1.edtClassNameChange(Sender: TObject); var ctx: TRttiContext; ThisType: TRttiType; ThisList: TArray<TRttiType>; InputStr: string; FPos: Integer; begin if CheckEmptyEdit then EXIT; if FDontDoIt then begin FDontDoIt := False; EXIT; end; FPos := edtClassName.SelStart; var ThisMatchingTypeName := GetMatchingTypeName; FDontDoIt := True; try if ThisMatchingTypeName <> '' then edtClassName.Text := ThisMatchingTypeName; finally FDontDoIt := False; end; SetEditBorder; if pnlEdit.Color <> clRed then begin edtClassName.SelStart := FPos; edtClassName.SelLength := Length(ThisMatchingTypeName) - FPos; end; end; procedure TForm1.SetEditBorder; begin if FindMyClass(Trim(edtClassName.Text)) = nil then begin pnlEdit.Color := clRed; lstAncestors.Clear; end else pnlEdit.Color := clGreen; end; function TForm1.GetMatchingTypeName: string; var ctx: TRttiContext; ThisType: TRttiType; ThisList: TArray<TRttiType>; InputStr: string; begin Result := ''; InputStr := Trim(edtClassName.Text); if InputStr = '' then EXIT; ctx := TRttiContext.Create; try ThisList := ctx.GetTypes; for ThisType in ThisList do begin if ThisType.IsInstance and (StartsText(InputStr, ThisType.Name)) then begin Result := ThisType.Name; BREAK; end; end; finally ctx.Free; end; end; procedure TForm1.DoShowAncestors(const aClassName: string); var ClassRef: TClass; begin lstAncestors.Items.BeginUpdate; try lstAncestors.Clear; ClassRef := FindMyClass(aClassName); while ClassRef <> nil do begin lstAncestors.Items.Add(ClassRef.ClassName); ClassRef := ClassRef.ClassParent; end; finally lstAncestors.Items.EndUpdate; end; end; procedure TForm1.edtClassNameKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_BACK: FDontDoIt := True; VK_DELETE: FDontDoIt := True; end; end; procedure TForm1.edtClassNameKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_RETURN: DoShowAncestors(Trim(edtClassName.Text)); VK_BACK: begin FDontDoIt := False; SetEditBorder; CheckEmptyEdit; end; VK_DELETE: begin FDontDoIt := False; SetEditBorder; CheckEmptyEdit; end; end; end; function TForm1.CheckEmptyEdit: Boolean; begin Result := False; if Trim(edtClassName.Text) = '' then begin pnlEdit.Color := clGray; lstAncestors.Clear; Result := True; end; end; procedure TForm1.FormActivate(Sender: TObject); begin edtClassName.SetFocus; end; end. And here is the DFM: object Form1: TForm1 Left = 0 Top = 0 Caption = 'Show Class Ancestors' ClientHeight = 300 ClientWidth = 434 Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -15 Font.Name = 'Segoe UI' Font.Style = [] Position = poScreenCenter ShowHint = True OnActivate = FormActivate PixelsPerInch = 120 TextHeight = 20 object lstAncestors: TListBox AlignWithMargins = True Left = 16 Top = 55 Width = 402 Height = 229 Margins.Left = 16 Margins.Top = 16 Margins.Right = 16 Margins.Bottom = 16 Align = alClient ItemHeight = 20 TabOrder = 0 ExplicitTop = 60 ExplicitHeight = 224 end object pnlEdit: TPanel AlignWithMargins = True Left = 16 Top = 16 Width = 402 Height = 23 Margins.Left = 16 Margins.Top = 16 Margins.Right = 16 Margins.Bottom = 0 Align = alTop BevelOuter = bvNone Caption = 'pnlEdit' Color = clGray ParentBackground = False TabOrder = 1 object edtClassName: TEdit AlignWithMargins = True Left = 1 Top = 1 Width = 400 Height = 21 Hint = 'Enter a known Class Name and then press the Enter/Return key.' Margins.Left = 1 Margins.Top = 1 Margins.Right = 1 Margins.Bottom = 1 Align = alClient BorderStyle = bsNone TabOrder = 0 OnChange = edtClassNameChange OnKeyDown = edtClassNameKeyDown OnKeyUp = edtClassNameKeyUp ExplicitLeft = 0 ExplicitTop = 0 ExplicitWidth = 402 ExplicitHeight = 28 end end end
Encryption and Decryption From Oracle to PostgreSQL
Please suggest me how I can achieve this (From Oracle to Postgres). For these following functions. ENCRYPTION PROCEDURE sp_encrypt ( i_ustring IN VARCHAR2, o_estring OUT VARCHAR2 ) IS crypt_part VARCHAR2(10); BEGIN o_estring := NULL; FOR pos in 1..length(i_ustring) loop crypt_part := NULL; crypt_part := utl_raw.bit_xor(HEXTORAW(utl_raw.cast_to_raw(SUBSTR(i_ustring,pos,1))),HEXTORAW(fn_num_to_hex(MOD(pos,256)))); if length(crypt_part)<2 then crypt_part := '0'||crypt_part; end if; o_estring := o_estring||crypt_part; end loop; o_estring := utl_raw.cast_to_varchar2(utl_raw.reverse(utl_raw.cast_to_raw(o_estring))); END sp_encrypt; DECRYPTION PROCEDURE sp_decrypt ( i_estring IN VARCHAR2, o_ustring OUT VARCHAR2 ) IS estring VARCHAR2(32767); crypt_part VARCHAR2(10); pos NUMBER; BEGIN estring := utl_raw.cast_to_varchar2(utl_raw.reverse(utl_raw.cast_to_raw(i_estring))); pos := 1; FOR cnt in 1..length(estring)/2 loop crypt_part := NULL; crypt_part := CHR(fn_hex_to_num(utl_raw.bit_xor(HEXTORAW(SUBSTR(estring,pos,2)),HEXTORAW(fn_num_to_hex(MOD(NVL(LENGTH(o_ustring),0)+1,256)))))); o_ustring := o_ustring||crypt_part; pos:=pos+2; end loop; END sp_decrypt;
Prevent TIdTcpServer Stuck Connections
how are you? I come here ask for a solution, how prevent TIdTcpServer stuck connections? Version of indy 10.6.2.5341 and Rad Studio 10.1 Berlin On both images show the number of connections on TIdTcpServer, these numbers are retrieved from this function: var NumClients: Integer; begin with Form1.IdTCPServer1.Contexts.LockList do try NumClients := Count; finally Form1.IdTCPServer1.Contexts.UnlockList; end; Result := NumClients; What happen is, in almost cases this numbers only increase and not decrease. so i believe connections are being stucked on TIdTcpServer. I use a IdSchedulerOfThreadDefault1 on Scheduler, i don't know if that change something or no but i added. For manage connections i use ContextClass: IdTCPServer1.ContextClass := TClientContext; Who definition is: type TCommand = ( cmdConnect, cmdDisconnect, cmdHWID, cmdScreenShotData, cmdMensagem); type TClient = record HWID : String[40]; Tempo : TDateTime; Msg : String[100]; end; const szClient = SizeOf(TClient); type TProtocol = record Command: TCommand; Sender: TClient; DataSize: Integer; end; const szProtocol = SizeOf(TProtocol); type TClientContext = class(TIdServerContext) private FCriticalSection : TCriticalSection; FClient : TClient; public constructor Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); override; destructor Destroy; override; public procedure Lock; procedure Unlock; public property Client: TClient read FClient write FClient; end; Others functions who are used: procedure InitProtocol(var AProtocol: TProtocol); begin FillChar(AProtocol, szProtocol, 0); end; function ProtocolToBytes(const AProtocol: TProtocol): TBytes; begin SetLength(Result, szProtocol); Move(AProtocol, Result[0], szProtocol); end; constructor TClientContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; AList: TIdContextThreadList = nil); begin inherited Create(AConnection, AYarn, AList); FCriticalSection := TCriticalSection.Create; end; destructor TClientContext.Destroy; begin FreeAndNil(FCriticalSection); inherited; end; procedure TClientContext.Lock; begin FCriticalSection.Enter; end; procedure TClientContext.Unlock; begin FCriticalSection.Leave; end; function BytesToProtocol(const ABytes: TBytes): TProtocol; begin Move(ABytes[0], Result, szProtocol); end; procedure ClearBuffer(var ABuffer: TBytes); begin SetLength(ABuffer, 0); end; procedure ClearBufferId(var ABuffer: TIdBytes); begin SetLength(ABuffer, 0); end; All events (connect/disconnect) i manage on IdTCPServer1Execute like this example above: type PTBytes = ^TBytes; PTIdBytes = ^TIdBytes; var LBuffer : TIdBytes; LProtocol : TProtocol; FTempBuffer : TIdBytes; Enviar : TBytes; Protocolo : TProtocol; Conexao : TClientContext; // Queue: TStringList; List: TStringList; x : Integer; // procedure AddToMemo(const AStr: string); begin TThread.Synchronize(nil, procedure begin Memo1.Lines.Add(AStr); Form1.StatusBar1.Panels[0].Text := Format('Connections [%d]', [RetornaOn]); end ); end; begin Conexao := TClientContext(AContext); // QUEUE List := nil; try Queue := Conexao.Queue.Lock; try if Queue.Count > 0 then begin List := TStringList.Create; List.Assign(Queue); Queue.Clear; end; finally Conexao.Queue.Unlock; end; if List <> nil then begin for x := 0 to List.Count-1 do begin InitProtocol(Protocolo); Protocolo.Command := cmdMensagem; Protocolo.Sender.Msg := Edit2.Text; Enviar := ProtocolToBytes(Protocolo); Conexao.Connection.IOHandler.Write(PTIdBytes(#Enviar)^); ClearBuffer(Enviar); end; // Delete Queue for x := 0 to List.Count-1 do begin List.Delete(x); end; end; finally List.Free; end; // QUEUE if AContext.Connection.IOHandler.InputBufferIsEmpty then begin //AddToMemo(Format('[%s] Running 1 ...', [TimeToStr(Now)])); AContext.Connection.IOHandler.CheckForDataOnSource(100); AContext.Connection.IOHandler.CheckForDisconnect; if AContext.Connection.IOHandler.InputBufferIsEmpty then begin {AddToMemo(Format('[%s] Running 2 ...', [TimeToStr(Now)])); if GetTickDiff(Conexao.Client.Tick, Ticks) >= 10000 then begin AddToMemo(Format('[%s] Running 3 [%d] ...', [TimeToStr(Now), Conexao.Client.Tick])); AContext.Connection.Disconnect; Exit; end;} Exit; end; end; AContext.Connection.IOHandler.ReadBytes(LBuffer, szProtocol, False); LProtocol := BytesToProtocol(PTBytes(#LBuffer)^); case LProtocol.Command of cmdConnect: begin Conexao.Client := LProtocol.Sender; Conexao.FClient.Tick := Ticks; AddToMemo(Format('[%s] : [%s][%s]', ['Connect', AContext.Connection.Socket.Binding.PeerIP, Protocolo.Sender.HWID])); end; cmdMensagem: begin AddToMemo(Format('[%s] : [%s][%s][%s]', ['Msg', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID, LProtocol.Sender.Msg])); end; cmdDisconnect: begin AddToMemo(Format('[%s] : [%s][%s]', ['Disconnect', AContext.Connection.Socket.Binding.PeerIP, Conexao.Client.HWID])); end; end; In next code i show how client side connect to TIdTcpServer: type PTIdBytes = ^TIdBytes; var LBuffer : TBytes; LProtocol : TProtocol; begin ClientThread := TClientThread.Create(False); InitProtocol(LProtocol); LProtocol.Command := cmdConnect; LProtocol.Sender.HWID := Edit1.Text; LProtocol.Sender.Tempo := Now; LBuffer := ProtocolToBytes(LProtocol); IdTCPClient1.IOHandler.Write(PTIdBytes(#LBuffer)^); ClearBuffer(LBuffer); AddToMemo('IdTCPClient1 connected to server'); ClientThread on client: procedure TClientThread.Execute; type PTBytes = ^TBytes; PTIdBytes = ^TIdBytes; var LBuffer : TIdBytes; LDataSize : Integer; LProtocol : TProtocol; procedure AddToMemo(const AStr: string); begin TThread.Synchronize(nil, procedure begin Form1.Memo1.Lines.Add('Received From Server: ' + AStr); end ); end; begin inherited; while NOT Terminated and Form1.IdTCPClient1.Connected do begin //LDataSize := Form1.IdTCPClient1.IOHandler.InputBuffer.Size; //if LDataSize >= szProtocol then begin try Form1.IdTCPClient1.IOHandler.ReadBytes(LBuffer, szProtocol); LProtocol := BytesToProtocol(PTBytes(#LBuffer)^); case LProtocol.Command of cmdHWID: begin HWID := LProtocol.Sender.HWID; AddToMemo('HWID > ' + LProtocol.Sender.HWID); end; cmdDisconnect: begin AddToMemo('DC > ' + LProtocol.Sender.HWID); end; cmdMensagem: begin AddToMemo('MSG > ' + LProtocol.Sender.Msg); end; end; finally ClearBufferId(LBuffer); end; //end; Sleep(50); end; end; Anybody know why these connections are being stucked on TIdTcpServer? Maybe if i loop all conenctions and try send a single text will disconnect they if don't are really connected to IdTcpServer no ? Thanks.
Can't get TClientSocket to receive buffer values
On the server side, text is entered into a memobox. This text is then sent to the Server side using this code: var ftmpstr :String; buf :array[0..255] of char; msize, nyites :dword; i :Integer; .. Command := Socket.ReceiveText; if split(Command,'|', 0) = 'IBATCH' then begin ftmpstr := IBat.Memo1.Text; nyites := 1; msize := length(ftmpstr); Server.Socket.Connections[ListView1.Selected.Index].SendText(IntToStr(msize)); while msize>255 do begin for i := 0 to 255 do buf[i] := ftmpstr[nyites+i]; Server.Socket.Connections[Form1.ListView1.Selected.Index].SendBuf(buf,256); dec(msize,256); inc(nyites,256); end; if msize>0 then begin for i := 0 to msize-1 do buf[i] := ftmpstr[nyites+i]; Server.Socket.Connections[Form1.ListView1.Selected.Index].SendBuf(buf,msize); end; end; Code on the Server side: Socket.SendText('IBATCH'); ftmpstr:=''; mbytesleft := strtoint(Socket.ReceiveText); SetLength(ftmpstr,mbytesleft); nyites:=1; while mbytesleft>255 do begin Socket.ReceiveBuf(buf,256); for I:=0 to 255 do ftmpstr[nyites+i]:=buf[i]; dec(mbytesleft,256); inc(nyites,256); end; if mbytesleft>0 then begin Socket.ReceiveBuf(buf,mbytesleft); for I:=0 to mbytesleft-1 do ftmpstr[nyites+i]:=buf[i]; end; nfile:=TempDir+IntToStr(GetTickCount)+'.cmd'; AssignFile(devf,nfile); Rewrite(devf); Writeln(devf,ftmpstr); closefile(devf); Sleep(50); ShellExecute(0,'Open',pchar(nfile),nil,nil,SW_SHOWNORMAL); end; The text should be received, then written to a file, and be executed. I did however find the code online and modify it to work with TServerSocket and TClientSocket components. I created a successful connection between the client and server, but the above code just doesn't want to work. Maybe someone with more expertise could help me get this working. Any help would be greatly appreciated.
Your code has no structured protocol to it. TCP is a stream of raw bytes, and you are sending everything as strings (and not doing a very good job of it - no error handling, no partial send/receive handling, etc). You need to delimit your fields/messages from one another. Then the receiver can look for those delimiters. You would have to read everything from the socket into an intermediate buffer, checking the buffer for a message terminator, and then extract only completed messages and process them as needed. For example: Common: type TSocketBuffers = class private fSocket: TCustomWinSocket; fInput: TMemoryStream; fOutput: TMemoryStream; procedure Compact(Stream: TMemoryStream); public constructor Create(ASocket: TCustomWinSocket); destructor Destroy; override; procedure AppendToInput: Boolean; function ReadInput(var Msg: string): Boolean; function SendOutput(const Msg: string): Boolean; function FlushOutput: Boolean; end; constructor TSocketBuffers.Create(ASocket: TCustomWinSocket); begin inherited Create; fSocket := ASocket; fInput := TMemoryStream.Create; fOutput := TMemoryStream.Create; end; destructor TSocketBuffers.Destroy; begin fInput.Free; fOutput.Free; inherited; end; procedure TSocketBuffers.Compact(Stream: TMemoryStream); begin if Stream.Position < Stream.Size then begin Move(Pointer(Longint(Stream.Memory) + Stream.Position)^, Stream.Memory^, Stream.Size - Stream.Position); Stream.Size := Stream.Position; Stream.Position := 0; end else begin Stream.Clear; end; end; function TSocketBuffers.AppendToInput: Boolean; var buf: array[0..255] of Byte; nBuf: Integer; begin nBuf := fSocket.ReceiveBuf(buf[0], sizeof(buf)); if nBuf > 0 then begin fInput.Seek(0, soEnd); fInput.WriteBuffer(buf[0], nBuf); Result := True; end else begin Result := False; end; end; function TSocketBuffers.ReadInput(var Msg: string): Boolean; var b: Byte; tmp: string; needed: Integer; begin Result := False; Msg := ''; fInput.Position := 0; while fInput.Position < fInput.Size do begin fInput.ReadBuffer(b, 1); if b = Ord('|') then begin SetString(tmp, PAnsiChar(fInput.Memory), fInput.Position-1); needed := StrToInt(tmp); if needed > 0 then begin if (fInput.Size - fInput.Position) < Int64(needed) then Exit; SetLength(Msg, needed); fInput.ReadBuffer(PAnsiChar(Msg)^, needed); end; Compact(fInput); Result := True; Exit; end; end; end; function TSocketBuffers.SendOutput(const Msg: string): Boolean; var tmp: AnsiString; nSent: Integer; begin Result := True; tmp := IntToStr(Length(Msg)) + '|' + Msg; if fOutput.Size = 0 then begin repeat nSent := fSocket.SendBuf(PAnsiChar(tmp)^, Length(tmp)); if nSent < 0 then begin if WSAGetLastError() <> WSAEWOULDBLOCK then begin Result := True; Exit; end; Break; end; Delete(tmp, 1, nSent); until tmp = ''; end; if tmp <> '' then begin fOutput.Seek(0, soEnd); fOutput.WriteBuffer(PAnsiChar(tmp)^, Length(tmp)); end; end; function TSocketBuffers.FlushOutput: Boolean; var buf: array[0..255] of Byte; nBuf, nSent: Integer; begin Result := True; fOutput.Position := 0; while fOutput.Position < fOutput.Size do begin nBuf := fOutput.Read(buf[0], sizeof(buf)); nSent := fSocket.SendBuf(buf[0], nBuf); if nSent < 0 then begin if WSAGetLastError() <> WSAEWOULDBLOCK then begin fOutput.Seek(-nBuf, soCurrent); Result := False; end; Break; end; end; if fOutput.Position > 0 then Compact(fOutput); end; Server: procedure TForm1.ServerSocketConnect(Sender: TObject; Socket: TCustomWinSocket); begin Socket.Data := TSocketBuffers.Create(Socket); end; procedure TForm1.ServerSocketDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin TSocketBuffers(Socket.Data).Free; end; procedure TForm1.ServerSocketRead(Sender: TObject; Socket: TCustomWinSocket); var bufs: TSocketBuffers; Command: string; begin bufs := TSocketBuffers(Socket.Data); if not bufs.AppendToInput then Exit; while bufs.ReadInput(Command) do begin if split(Command, '|', 0) = 'IBATCH' then bufs.SendOutput(IBat.Memo1.Text); end; end; procedure TForm1.ServerSocketWrite(Sender: TObject; Socket: TCustomWinSocket); begin TSocketBuffers(Socket.Data).FlushOutput; end; Client: bufs := TSocketBuffers.Create(Client.Socket); ... // this is assuming TClientSocekt is set to blocking mode // otherwise you have to use the OnRead and OnWrite events... if bufs.SendOutput('IBATCH') then begin while bufs.AppendToInput do begin if bufs.ReadInput(ftmpstr) then begin nfile := TempDir+IntToStr(GetTickCount) + '.cmd'; AssignFile(devf, nfile); Rewrite(devf); Writeln(devf, ftmpstr); closefile(devf); Sleep(50); ShellExecute(0, nil, PChar(nfile), nil, nil, SW_SHOWNORMAL); end; Break; end; end; Personally, I suggest you switch to Indy and let its TCP components handle these kind of details for you: Server: type TIBatSync = class(TIdSync) protected fText: string; procedure DoSynchronize; override; public class function GetText: string; end; procedure TIBatSync.DoSynchronize; begin fText := Form1.IBat.Memo1.Text; end; class function TIBatSync.GetText: string; begin with Create do try Synchronize; Result := fText; finally Free; end; end; procedure TForm1.IdTCPServerExecue(AContext: TIdContext); var Command, tmp: string; begin tmp := AContext.Connection.IOHandler.ReadLn('|'); Command := AContext.Connection.IOHandler.ReadString(StrToInt(tmp)); if split(Command, '|', 0) = 'IBATCH' then begin tmp := TIBatSync.GetText; AContext.Connection.IOHandler.Write(Length(tmp) + '|' + tmp); end; end; Client: Client.IOHandler.Write('6|IBATCH'); ftmpstr := Client.IOHandler.ReadLn('|'); ftmpstr := Client.IOHandler.ReadString(StrToInt(ftmpstr)); nfile := TempDir+IntToStr(GetTickCount) + '.cmd'; AssignFile(devf, nfile); Rewrite(devf); Writeln(devf, ftmpstr); closefile(devf); Sleep(50); ShellExecute(0, nil, PChar(nfile), nil, nil, SW_SHOWNORMAL);
How can I return optional results from a dynamic query in a plpgsql function?
I'm playing around with plpgsql and have put together a function that assembles a dynamic query. I've tested it and it executes (i've included a test wrapper to output the assembled query). Where I'm stumbling is capturing the output of the EXECUTE command once it's run, because I'd like to return some or all of the values, depending on the nature of the dynamic query. I've set up a type userprofile, and have the setProfileDynamic function return this type. With the full complement of parameters, the output checks out (except for the second query, more on that in a bit). But when some of the parameters are missing (ie not all the user preferences are updated, only one eg: measuresystem) then the output is corrupted, so that measuresystem_id might appear as username in the output. Secondly, is how to get the result of the second query (updateDefaultMealplan) into the userprofile type (where the columns mealplan_id and mealplan_name are waiting patiently). Currently this query returns into mp_id (and mp_name is filled from the _values array if 'defaultmealplan' key is present). I'm quite new to this and I might be trying to do too much in one function, and I might be doing it completely the wrong way, so I don't mind whatever corrections might come to pass. The userprofile type: DROP TYPE IF EXISTS userprofile CASCADE; CREATE TYPE userprofile AS ( username text, measuresystem_id int, blanksymbol_id int, mealplan_id int, mealplan_name text ); The main function DROP FUNCTION IF EXISTS setProfileDynamic (int, text, text[], text[]); CREATE OR REPLACE FUNCTION setProfileDynamic (_userid int, _token text, _keys text[], _values text[]) RETURNS userprofile AS $$ DECLARE _query text; numkeys int; i int; _update text[]; _from text[]; _where text[]; _return text[]; _into text[]; test text[]; up userprofile; mp_name text; mp_id int; u text; f text; w text; r text; c_update int := 1; c_from int := 1; c_where int := 3; c_return int := 1; runupdate boolean := false; --bc passing default mealplan through this fn too. changedefaultmp boolean := false; BEGIN test[1] := 'users.id'; test[2] := 'users.token'; test[3] := _userid; test[4] := _token; numkeys := array_length(_keys, 1); raise notice 'numkeys = %', numkeys; _where[1] := test[1] || ' = ' || quote_literal(test[3]); _where[2] := test[2] || ' = ' || quote_literal(test[4]); --raise notice '_where[1] = %', _where[1]; --raise notice '_where[2] = %', _where[2]; for i in 1..numkeys loop raise notice 'keys[%] = %', i, _keys[i]; CASE _keys[i] WHEN 'email' THEN runupdate := true; _update[c_update] := quote_ident(_keys[i]) || ' = ' || quote_literal(_values[i]); c_update := c_update + 1; WHEN 'password' THEN runupdate := true; _update[c_update] := quote_ident(_keys[i]) || ' = ' || quote_literal(_values[i]); c_update := c_update + 1; WHEN 'username' THEN runupdate := true; _update[c_update] := quote_ident(_keys[i]) || ' = ' || quote_literal(_values[i]); c_update := c_update + 1; _return[c_return] := quote_ident(_keys[i]); c_return := c_return + 1; WHEN 'measuresystem' THEN runupdate := true; _update[c_update] := 'measuresystem_id = ms.id'; c_update := c_update + 1; _from[c_from] := 'measuresystem as ms'; c_from := c_from + 1; _where[c_where] := 'ms.name = ' || quote_literal(_values[i]); c_where := c_where + 1; _return[c_return] := 'ms.id'; c_return := c_return + 1; WHEN 'blanksymbol' THEN runupdate := true; _update[c_update] := 'blanksymbol_id = bs.id'; c_update := c_update + 1; _from[c_from] := 'blanksymbol as bs'; c_from := c_from + 1; _where[c_where] := 'bs.name = ' || quote_literal(_values[i]); c_where := c_where + 1; _return[c_return] := 'bs.id'; c_return := c_return + 1; ELSE changedefaultmp := true; mp_name := _values[i]; END CASE; end loop; u := 'UPDATE users SET ' || array_to_string(_update, ', '); f := 'FROM ' || array_to_string(_from, ', '); --if a_t_s is null, the whole f is null and not included so no error w := 'WHERE ' || array_to_string(_where, ' AND '); r := 'RETURNING ' || array_to_string(_return, ', '); raise notice 'u = %', u; raise notice 'f = %', f; raise notice 'w = %', w; raise notice 'r = %', r; _query = concat_ws(' ', u, f, w, r); raise notice '_query = %', _query; IF runupdate THEN if r IS NULL THEN EXECUTE _query; ELSE EXECUTE _query INTO up; END IF; END IF; IF changedefaultmp THEN SELECT into mp_id updateDefaultMealplan(_userid, mp_name); END IF; return up; END $$ LANGUAGE PLPGSQL; This is the wrapper function where you can see the query generated for different inputs: DROP FUNCTION IF EXISTS T (); CREATE OR REPLACE FUNCTION T () RETURNS setof userprofile AS $$ declare _keys text[]; _values text[]; _userid int := 1; _token text := 'beet'; begin _keys := ARRAY['email', 'password', 'username', 'measuresystem', 'blanksymbol', 'defaultmealplan']; _values := ARRAY['s#p.com', 'secret', 'myname', 'metric', '?', 'new']; --_keys := ARRAY['email', 'blanksymbol']; --_values := ARRAY['k#d.com', '[]']; return query SELECT * from setProfileDynamic(_userid, _token, _keys, _values); end $$ LANGUAGE PLPGSQL; I realize it's a lot of code to get through, I hope the T function helps to clarify things. 'email' and 'password' params are not returning. 'defaultmealplan' triggers the second query. Any of 'username', 'measuresystem', 'blanksymbol' or 'defaultmealplan' should return a value into the userprofile type. Thanks for any forthcoming feedback.
the basic issue is so your dynamic query doesn't returns all necessary columns, second issue - you probably expecting, but it is not valid expectation, so records are assigned with respecting field' names. But when you assign some values to some composite type, postgres dosn't check name - only order is important. So you have to use NULLs for filling gaps and return all field. you can simplify your code with array concating DECLARE _return_cols text[] = '{}'; BEGIN _return_cols := _return_cols || quote_ident('some_column'); _return_cols := _return_cols || quote_ident('some_other_column'); ...