Inno Setup ADO Connection for run sql query provides error - sql
I managed [code] section of my installer in order to run a simple sql script (a select against an existing db/table).
Compiles fine, retrieve correctly sql machine and instance using the right password but whenever running the installer, at a moment the setup aborts providing message "Microsoft OLE DB Provider for SQL Server: Could not find store procedure 'ÿƥS'.
Of course none of those characters were defined in the sql script (SELECT ##SERVERNAME AS SERVERNAME, DB_NAME() AS [DB_NAME], CURRENT_USER AS [CURRENT_USER]).
Here is the [Code] section:
[Code]
const
//some constants definition
var
//some var definition
var
Page: TWizardPage;
// Used to generate error code by sql script errors
procedure ExitProcess(exitCode:integer);
external 'ExitProcess#kernel32.dll stdcall';
// enable/disable child text boxes & functions when text has been entered into Server textbox. Makes no sense to populate child items unless a value exists for server.
Procedure ServerOnChange (Sender: TObject);
begin
//code there
end;
// enable/disable user/pass text boxes depending on selected auth type. A user/pass is only required for SQL Auth
procedure AuthOnChange (Sender: TObject);
begin
//code there
end;
// Enable next button once a database name has been entered.
Procedure DatabaseOnChange (Sender: TObject);
//code there
end;
// Retrieve a list of databases accessible on the server with the credentials specified.
// This list is shown in the database dropdown list
procedure RetrieveDatabaseList(Sender: TObject);
var
ADOCommand: Variant;
ADORecordset: Variant;
ADOConnection: Variant;
begin
lstDatabase.Items.Clear;
try
// create the ADO connection object
ADOConnection := CreateOleObject('ADODB.Connection');
// build a connection string; for more information, search for ADO
// connection string on the Internet
ADOConnection.ConnectionString :=
'Provider=SQLOLEDB;' + // provider
'Data Source=' + txtServer.Text + ';' + // server name
'Application Name=' + '{#SetupSetting("AppName")}' + ' DB List;'
if chkWindowsAuth.Checked then
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'Integrated Security=SSPI;' // Windows Auth
else
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'User Id=' + txtUsername.Text + ';' + // user name
'Password=' + txtPassword.Text + ';'; // password
// open the connection by the assigned ConnectionString
ADOConnection.Open;
try
// create the ADO command object
ADOCommand := CreateOleObject('ADODB.Command');
// assign the currently opened connection to ADO command object
ADOCommand.ActiveConnection := ADOConnection;
// assign text of a command to be issued against a provider
ADOCommand.CommandText := 'SELECT name FROM master.dbo.sysdatabases WHERE HAS_DBACCESS(name) = 1 ORDER BY name';
// this property setting means, that you're going to execute the
// CommandText text command; it does the same, like if you would
// use only adCmdText flag in the Execute statement
ADOCommand.CommandType := adCmdText;
// this will execute the command and return dataset
ADORecordset := ADOCommand.Execute;
// get values from a dataset using 0 based indexed field access;
// notice, that you can't directly concatenate constant strings
// with Variant data values
while not ADORecordset.eof do
begin
lstDatabase.Items.Add(ADORecordset.Fields(0));
ADORecordset.MoveNext;
end ;
finally
ADOConnection.Close;
end;
except
MsgBox(GetExceptionMessage, mbError, MB_OK);
end;
end;
// Execute files specified in [files] section (hardcoded) against the user defined server.database
procedure DeploySQL();
var
Myscript: AnsiString;
ADOCommand: Variant;
ADOConnection: Variant;
begin
// extract script
ExtractTemporaryFile('script.sql');
try
// create the ADO connection object
ADOConnection := CreateOleObject('ADODB.Connection');
// build a connection string; for more information, search for ADO
// connection string on the Internet
ADOConnection.ConnectionString :=
'Provider=SQLOLEDB;' + // provider
'Data Source=' + txtServer.Text + ';' + // server name
'Initial Catalog=' + lstDatabase.Text + ';' + // server name
'Application Name=' + '{#SetupSetting("AppName")}' + ' Execute SQL;' ;
if chkWindowsAuth.Checked then
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'Integrated Security=SSPI;' // Windows Auth
else
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'User Id=' + txtUsername.Text + ';' + // user name
'Password=' + txtPassword.Text + ';'; // password
// open the connection by the assigned ConnectionString
ADOConnection.Open;
try
// create the ADO command object
ADOCommand := CreateOleObject('ADODB.Command');
// assign the currently opened connection to ADO command object
ADOCommand.ActiveConnection := ADOConnection;
// load a script from file into variable.
if(LoadStringFromFile(ExpandConstant('{app}\script.sql'), Myscript)) then
begin
// assign text of a command to be issued against a provider. Append all 3 because one of the install assembly strings will always be empty.
ADOCommand.CommandText := Myscript;
// this will execute the script; the adCmdText flag here means
// you're going to execute the CommandText text command, while
// the adExecuteNoRecords flag ensures no data row will be get
// from a provider, what should improve performance
ADOCommand.Execute(NULL, NULL, adCmdText or adExecuteNoRecords);
end
else
begin
MsgBox('Installation files missing.', mbError, MB_OK);
ExitProcess(7);
end ;
finally
ADOConnection.Close;
end;
except
MsgBox(GetExceptionMessage, mbError, MB_OK);
ExitProcess(5);
end;
end;
{ CustomForm_NextkButtonClick }
// try to connect to supplied db. Dont need to catch errors/close conn on error because a failed connection is never opened.
function CustomForm_NextButtonClick(Page: TWizardPage): Boolean;
var
ADOConnection: Variant;
begin
//try
// create the ADO connection object
ADOConnection := CreateOleObject('ADODB.Connection');
// build a connection string; for more information, search for ADO
// connection string on the Internet
ADOConnection.ConnectionString :=
'Provider=SQLOLEDB;' + // provider
'Data Source=' + txtServer.Text + ';' + // server name
'Initial Catalog=' + lstDatabase.Text + ';' + // server name
'Application Name=' + '{#SetupSetting("AppName")}' + ' Execute SQL;' ;
if chkWindowsAuth.Checked then
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'Integrated Security=SSPI;' // Windows Auth
else
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'User Id=' + txtUsername.Text + ';' + // user name
'Password=' + txtPassword.Text + ';'; // password
// open the connection by the assigned ConnectionString
ADOConnection.Open;
Result := True;
end;
{ CustomForm_CreatePage }
function CustomForm_CreatePage(PreviousPageId: Integer): Integer;
begin
Page := CreateCustomPage(
PreviousPageId,
ExpandConstant('{cm:CustomForm_Caption}'),
ExpandConstant('{cm:CustomForm_Description}')
);
{ lblServer }
lblServer := TLabel.Create(Page);
with lblServer do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblServer_Caption0}');
Left := ScaleX(24);
Top := ScaleY(32);
Width := ScaleX(68);
Height := ScaleY(13);
Enabled := True;
end;
{ txtServer }
txtServer := TEdit.Create(Page);
with txtServer do
begin
Parent := Page.Surface;
Left := ScaleX(112);
Top := ScaleY(32);
Width := ScaleX(273);
Height := ScaleY(21);
TabOrder := 1;
Enabled := True;
OnChange := #ServerOnChange;
end;
{ lblAuthType }
lblAuthType := TLabel.Create(Page);
with lblAuthType do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblAuthType_Caption0}');
Left := ScaleX(24);
Top := ScaleY(72);
Width := ScaleX(87);
Height := ScaleY(13);
Enabled := False;
end;
{ chkWindowsAuth }
chkWindowsAuth := TRadioButton.Create(Page);
with chkWindowsAuth do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_chkWindowsAuth_Caption0}');
Left := ScaleX(32);
Top := ScaleY(88);
Width := ScaleX(177);
Height := ScaleY(17);
Checked := True;
TabOrder := 2;
TabStop := True;
OnClick := #AuthOnChange;
Enabled := False;
end;
{ chkSQLAuth }
chkSQLAuth := TRadioButton.Create(Page);
with chkSQLAuth do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_chkSQLAuth_Caption0}');
Left := ScaleX(32);
Top := ScaleY(108);
Width := ScaleX(185);
Height := ScaleY(17);
TabOrder := 3;
OnClick := #AuthOnChange;
Enabled := False;
end;
{ lblUser }
lblUser := TLabel.Create(Page);
with lblUser do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblUser_Caption0}');
Left := ScaleX(56);
Top := ScaleY(128);
Width := ScaleX(58);
Height := ScaleY(13);
Enabled := False;
end;
{ lblPassword }
lblPassword := TLabel.Create(Page);
with lblPassword do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblPassword_Caption0}');
Left := ScaleX(56);
Top := ScaleY(152);
Width := ScaleX(53);
Height := ScaleY(13);
Enabled := False;
end;
{ txtUsername }
txtUsername := TEdit.Create(Page);
with txtUsername do
begin
Parent := Page.Surface;
Left := ScaleX(120);
Top := ScaleY(128);
Width := ScaleX(241);
Height := ScaleY(21);
Enabled := False;
TabOrder := 4;
end;
{ txtPassword }
txtPassword := TPasswordEdit.Create(Page);
with txtPassword do
begin
Parent := Page.Surface;
Left := ScaleX(120);
Top := ScaleY(152);
Width := ScaleX(241);
Height := ScaleY(21);
Enabled := False;
TabOrder := 5;
end;
{ lblDatabase }
lblDatabase := TLabel.Create(Page);
with lblDatabase do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblDatabase_Caption0}');
Left := ScaleX(56);
Top := ScaleY(192);
Width := ScaleX(53);
Height := ScaleY(13);
Enabled := False;
end;
{ lstDatabase }
lstDatabase := TComboBox.Create(Page);
with lstDatabase do
begin
Parent := Page.Surface;
Left := ScaleX(120);
Top := ScaleY(192);
Width := ScaleX(145);
Height := ScaleY(21);
Enabled := False;
TabOrder := 6;
OnDropDown:= #RetrieveDatabaseList;
OnChange:= #DatabaseOnChange;
end;
with Page do
begin
OnNextButtonClick := #CustomForm_NextButtonClick;
end;
Result := Page.ID;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
// set initial status of next button. Should be disabled when page is first loaded, but should be enabled if user clicked back.
if CurPageID = Page.ID then
WizardForm.NextButton.Enabled := bIsNextEnabled;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
// The preinstall step seems like the best time to do the actual install. The problem is that this is not a traditional install. Nothing is copied to the users' pc
if CurStep = ssInstall then
DeploySQL;
end;
procedure InitializeWizard();
begin
bIsNextEnabled := False;
CustomForm_CreatePage(wpLicense);
end;
Any idea?
thanks
I got the solution!
Problem occurs in the if(LoadStringFromFile(ExpandConstant('{app}\script.sql'), Myscript)) statement because the sql file was not ANSI coded.
Everything gone fine by changing the coding.
thanks everybody!
Related
Is there any way to put text into SQL using Delphi? [duplicate]
Using Delphi 2010 Can anyone tell me what I am doing wrong here with my code. The comments show the errors that I receive with the particular methods that I tried to pass parameters to my ADOQuery procedure CreateAdminLogin(const APasswd: string); var qry: TADOQuery; //P1, P2: TParameter; begin qry := TADOQuery.Create(nil); try qry.Connection := frmDataModule.conMain; qry.SQL.Text := 'INSERT INTO Users (User_Id, Password) VALUES (:u, :p)'; //Syntax error in INTO statement qry.Parameters.ParamByName('u').Value:= 'Admin'; qry.Parameters.ParamByName('p').Value:= GetMd5(APasswd); //invalid variant operation {qry.Parameters.ParamByName('u').Value.AsString:= 'Admin'; qry.Parameters.ParamByName('p').Value.AsString:= GetMd5(APasswd);} //invalid variant operation {P1:= qry.Parameters.ParamByName('u'); P1.Value.asString:= 'Admin'; P2:= qry.Parameters.ParamByName('p'); P2.Value.asString:= GetMd5(APasswd);} qry.Prepared := True; qry.ExecSQL; finally qry.Free; end; end; NOTE: GetMD5 is declared as follows function GetMd5(const Value: String): string; var hash: MessageDigest_5.IMD5; fingerprint: string; begin hash := MessageDigest_5.GetMd5(); hash.Update(Value); fingerprint := hash.AsString(); Result := fingerprint; end; Thankx
This works fine for me, using the DBDemos.MDB file that shipped with Delphi (C:\Users\Public\Documents\RAD Studio\9.0\Samples\Data\dbdemos.mdb by the default installation) ADOQuery1.SQL.Clear; ADOQuery1.SQL.Add('INSERT INTO Country (Name, Capital, Continent, Area, Population)'); ADOQuery1.SQL.Add('VALUES (:Name, :Capital, :Continent, :Area, :Population)'); ADOQuery1.Parameters.ParamByName('Name').Value := 'SomePlace'; ADOQuery1.Parameters.ParamByName('Capital').Value := 'Pitsville'; ADOQuery1.Parameters.ParamByName('Continent').Value := 'Floating'; ADOQuery1.Parameters.ParamByName('Area').Value := 1234; ADOQuery1.Parameters.ParamByName('Population').Value := 56; ADOQuery1.ExecSQL; ADOQuery1.Close; // Open it to read the data back ADOQuery1.SQL.Text := 'SELECT * FROM Country WHERE Name = :Name'; ADOQuery1.Parameters.ParamByName('Name').Value := 'SomePlace'; ADOQuery1.Open; ShowMessage(ADOQuery1.FieldByName('Name').AsString);
For using like extra thing to know: Datasource SQL like this select * from Table where Phone like :param DataModule.findQuery.Parameters.ParamByName('param').Value:= '%%'+yourEdit.Text + '%%';
You should create parameters first: procedure CreateAdminLogin(const APasswd: string); var qry: TADOQuery; begin qry := TADOQuery.Create(nil); try // this part is missed in your code with qry.Parameters.AddParameter do begin Name := 'u'; DataType := ftString; end; with qry.Parameters.AddParameter do begin Name := 'p'; DataType := ftString; end; qry.Connection := frmDataModule.conMain; qry.SQL.Text := 'INSERT INTO Users (User_Id, Password) VALUES (:u, :p)'; // Now it will be ok! qry.Parameters.ParamByName('u').Value:= 'Admin'; qry.Parameters.ParamByName('p').Value:= GetMd5(APasswd); qry.Prepared := True; qry.ExecSQL; finally qry.Free; end; end;
How to fix Access Violation at address in Delphi
I'm new to delphi and am trying to start OOP. However I get an access violation when using public property to set a private field. type User = class; TData = class private CurrUser: User; Connection: TFDConnection; Query: TFDQuery; procedure SetUser(newUser: User); procedure SetConnection(newConn: TFDConnection); procedure SetQuery(newQry: TFDQuery); public property CUser: User read CurrUser write SetUser; property Conn: TFDConnection read Connection write SetConnection; property Qry: TFDQuery read Query write SetQuery; class procedure Login(uID: integer); static; class procedure Logout(uID: integer); static; class procedure ExitApp(); static; end; implementation {$R *.fmx} procedure TData.SetUser(newUser: User); begin CurrUser := newUser; end; procedure TData.SetConnection(newConn: TFDConnection); begin Connection := newConn; end; procedure TData.SetQuery(newQry: TFDQuery); begin Query := newQry; end; I expect to be able to set the Connection using that property however it gives me the access violation with any code that uses the property write: TData.Conn.LoginPrompt := False; TData.Conn.Connected := True; var TData: frmData.TData; LoginForm: TLoginForm; ErrorCount : integer; implementation {$R *.fmx} procedure TLoginForm.ExitAppButtonClick(Sender: TObject); begin TData.ExitApp; end; procedure TLoginForm.LoginButtonClick(Sender: TObject); var companyPath : string; nurseID : integer; begin if(UsernameInput.Text = '') or (PasswordInput.Text = '') or (PincodeInput.Text = '') then begin ShowMessage('Please enter your login details.'); Exit; end; try TData.Conn := TFDConnection.Create(nil); TData.Conn.Params.DriverID := 'MSAcc'; TData.Conn.Params.Database := 'D:\PulseDB\AlfaPersonnel\Pulse.mdb'; TData.Conn.LoginPrompt := False; TData.Conn.Connected := True; if(TData.Conn.Connected <> True) then begin ShowMessage('Could not connect, try again'); Exit; end else //When Connection begin TData.Qry := TFDQuery.Create(TData.Conn); try TData.Qry.Connection := TData.Conn; TData.Qry.SQL.Text := 'SELECT * FROM NurseLogin WHERE Username=:uname AND Password=:pword AND PinCode=:pin;'; TData.Qry.Params.ParamByName('uname').AsString := UsernameInput.Text; TData.Qry.Params.ParamByName('pword').AsString := PasswordInput.Text; TData.Qry.Params.ParamByName('pin').AsString := PincodeInput.Text; TData.Qry.Active := True; if TData.Qry.RecordCount = 0 then ShowMessage('Details not recognised.') else if TData.Qry.RecordCount = 1 then begin if TData.Qry.FieldByName('IsActive').AsBoolean then //If the user is active begin try //Connect to the path companyPath := TData.Qry.FieldByName('CompanyName').AsString; TData.Conn.Params.Database := 'D\PulseDB\' + companyPath + '\Pulse.mdb'; TData.Conn.Connected := True; ShowMessage('Connected to ' + companyPath); finally end; end; end; finally end; end; finally end; end;
You don't ever create an instance of your TData class. At some point you need to write: TData := frmData.TData.Create; Which is how you instantiate an instance. And you need to destroy it when you are finished also. Like this: TData.Free; That you did not instantiate an instance is the explanation for your access violation. Some other issues: Use the T prefix for types. Your variable should be named Data rather than TData. Don't use global variables if at all possible.
Run Windows Explorer beside my application with a specified Bounds
I have this: ShellExecute(Application.Handle, nil, PWideChar('explorer.exe'), PWideChar(ImagesDir), nil, SW_SHOWNORMAL); where the variable ImagesDir is the directory of Images that I want to show by the Windows Explorer... How can I run the Windows Explorer beside my application at a specified Bounds, for exemple like this?
when you open any File Explorer window (such as going to C:\ ), File Explorer has a specific saved window size that it opens with. So when you resize it, either horizontally and/or vertically, close it and re-open it again, it saves the size of the window, and the location within the Registry where this information is saved is this: On my system, HKCU\Software\Classes\Local Settings\Software\Microsoft\Windows\Shell\Bags\AllFolders\Shell\WinPos1366x768x96(1)..position, where position is left, right, top or bottom, gives the position of the window border in pixels. I assume the name of the key depends on the screen resolution.here and the code will be like that: ..... const AMainKey = '\Software\Classes\Local Settings\Software\Microsoft\Windows\Shell\Bags\AllFolders\Shell\'; var FrmMain: TFrmMain; ImagesDir: string; AWinPos_left, AWinPos_Top, AWinPos_Right, AWinPos_Bottom: string; implementation Uses ShellApi, Registry; {$R *.dfm} procedure ExploreDir_With_Bounds(AFile_Dir: string;ALeft, ATop, AWidth, AHieght: DWORD); FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN; BEGIN Result :=(ShellExecute(GetDesktopWindow,'open',PWideChar(Dir),'','',SW_SHOW)>32) END; var ListNames, ListPosition: TStringList; I, AScreen_Width, AScreen_Hieght, APixelPI: Integer; AWinPos_Uses: string; begin ListNames := TStringList.Create; ListPosition := TStringList.Create; With TRegistry.Create Do Try RootKey := HKEY_CURRENT_USER; OpenKey(AMainKey,FALSE); GetValueNames(ListNames); AScreen_Width := Screen.Width; AScreen_Hieght := Screen.Height; APixelPI := Screen.PixelsPerInch; AWinPos_Uses := 'WinPos'+AScreen_Width.ToString+'x'+AScreen_Hieght.ToString+'x'+APixelPI.ToString; for I := 0 to ListNames.Count - 1 do begin if Pos(AWinPos_Uses, ListNames[I]) <> 0 then begin ListPosition.Add(ListNames[I]); end; end; for I := 0 to ListPosition.Count - 1 do begin if (Pos('left', ListPosition[I]) <> 0) then begin AWinPos_left := ListPosition[I]; Lbl_Left.Caption := AWinPos_left; Continue; end else if (Pos('top', ListPosition[I]) <> 0) then begin AWinPos_Top := ListPosition[I]; Lbl_Top.Caption := AWinPos_Top; Continue; end else if (Pos('right', ListPosition[I]) <> 0) then begin AWinPos_Right := ListPosition[I]; Lbl_Right.Caption := AWinPos_Right; Continue; end else if (Pos('bottom', ListPosition[I]) <> 0) then begin AWinPos_Bottom := ListPosition[I]; Lbl_Bottom.Caption := AWinPos_Bottom; end; end; if (AWinPos_left <> '')and(AWinPos_Top <> '')and (AWinPos_Right <> '')and(AWinPos_Bottom <> '') then begin WriteInteger(AWinPos_left, ALeft); WriteInteger(AWinPos_Top, ATop); WriteInteger(AWinPos_Right, ALeft + AWidth); WriteInteger(AWinPos_Bottom, ATop + AHieght); end; CloseKey; Finally Free; ListNames.Free; ListPosition.Free; End; ExploreDirectory(AFile_Dir); end; procedure TFrmMain.FormCreate(Sender: TObject); begin ImagesDir := TDirectory.GetParent(TDirectory.GetParent(ExtractFileDir(ParamStr(0))))+ '\My Images To Test'; ExploreDir_With_Bounds(ImagesDir, (50 + Width)+10{Left}, 50{TOP}, Screen.Width - (Left + Width +20){width}, Screen.Height - 150{hieght}); end; procedure TFrmMain.FormShow(Sender: TObject); begin Left := 0; Top := (Screen.WorkAreaHeight div 2)-(Height div 2); end; end. the Result here
You can use the following function to open an explorer window and have it point to a specific directory. USES Windows,ShellAPI; FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN; BEGIN Result:=(ShellExecute(GetDesktopWindow,'open',PChar(Dir),'','',SW_SHOW)>32) END; Note, however, that you can't (with this code) make the Explorer window "follow" your program, ie. the opened window is a completely autonomous window that has no link to your program, just as if the user had browsed to the directory himself. If you call this function again with a new directory, Explorer will open a new window with that directory (and keep the old one opened). UPDATE: If you want to be able to manipulate the explorer window after it is opened, you need to use the various interfaces that Explorer exposes. I have made a UNIT that allows you to do what you seek as well as returning the interface needed to be able to manipulate the window afterwards. It is heavily based on the code found in this answer: Check if windows explorer already opened on given path by Victoria UNIT WindowsExplorer; INTERFACE USES Types,ShDocVw; FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN; FUNCTION OpenFolder(CONST Dir : STRING) : IWebBrowserApp; OVERLOAD; FUNCTION OpenFolderAt(CONST Dir : STRING ; Left,Top,Width,Height : INTEGER) : IWebBrowserApp; OVERLOAD; FUNCTION OpenFolderAt(CONST Dir : STRING ; CONST Rect : TRect) : IWebBrowserApp; OVERLOAD; INLINE; IMPLEMENTATION USES Windows,Variants,ShlObj,Ole2,OleAuto,ShellAPI,ActiveX,SysUtils; FUNCTION ExploreDirectory(CONST Dir : STRING) : BOOLEAN; BEGIN Result:=(ShellExecute(GetDesktopWindow,'open',PChar(Dir),'','',SW_SHOW)>32) END; FUNCTION GetFolderIDList(CONST Dir : STRING) : PItemIDList; VAR ShellFolder : IShellFolder; Attributes : ULONG; Count : ULONG; BEGIN OleCheck(SHGetDesktopFolder(ShellFolder)); Attributes:=SFGAO_FOLDER or SFGAO_STREAM; OleCheck(ShellFolder.ParseDisplayName(0,NIL,PWideChar(WideString(Dir)),Count,Result,Attributes)); IF NOT ((Attributes AND SFGAO_FOLDER=SFGAO_FOLDER) AND (Attributes AND SFGAO_STREAM<>SFGAO_STREAM)) THEN BEGIN CoTaskMemFree(Result); Result:=NIL END END; FUNCTION OpenFolder(CONST Dir : STRING ; OpenIfNotFound : BOOLEAN) : IWebBrowserApp; OVERLOAD; CONST IID_IServiceProvider: System.TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}'; VAR FolderID : PItemIDList; ShellWindows : IShellWindows; I : INTEGER; WndIFace : System.IDispatch; WebBrowserApp : IWebBrowserApp; ServiceProvider : IServiceProvider; ShellBrowser : IShellBrowser; ShellView : IShellView; FolderView : IFolderView; PersistFolder : IPersistFolder2; CurFolderID : PItemIDList; BEGIN FolderID:=GetFolderIDList(Dir); IF Assigned(FolderID) THEN TRY OleCheck(CoCreateInstance(CLASS_ShellWindows,NIL,CLSCTX_LOCAL_SERVER,IID_IShellWindows,ShellWindows)); FOR I:=0 TO PRED(ShellWindows.Count) DO BEGIN WndIface:=ShellWindows.Item(VarAsType(I,VT_I4)); IF Assigned(WndIface) AND Succeeded(WndIface.QueryInterface(IID_IWebBrowserApp,WebBrowserApp)) AND Succeeded(WebBrowserApp.QueryInterface(IID_IServiceProvider,ServiceProvider)) AND Succeeded(ServiceProvider.QueryService(SID_STopLevelBrowser,IID_IShellBrowser,ShellBrowser)) AND Succeeded(ShellBrowser.QueryActiveShellView(ShellView)) AND Succeeded(ShellView.QueryInterface(IID_IFolderView,FolderView)) AND Succeeded(FolderView.GetFolder(IID_IPersistFolder2,PersistFolder)) AND Succeeded(PersistFolder.GetCurFolder(CurFolderID)) AND ILIsEqual(FolderID,CurFolderID) THEN BEGIN IF IsIconic(WebBrowserApp.HWnd) THEN Win32Check(ShowWindow(WebBrowserApp.HWnd,SW_RESTORE)); Win32Check(SetForegroundWindow(WebBrowserApp.HWnd)); Exit(WebBrowserApp) END END FINALLY CoTaskMemFree(FolderID) END; Result:=NIL; IF OpenIfNotFound THEN BEGIN IF NOT ExploreDirectory(Dir) THEN EXIT; FOR I:=1 TO 20 DO BEGIN Result:=OpenFolder(Dir,FALSE); IF Assigned(Result) THEN EXIT; Sleep(100) END END END; FUNCTION OpenFolder(CONST Dir : STRING) : IWebBrowserApp; BEGIN Result:=OpenFolder(Dir,TRUE) END; FUNCTION OpenFolderAt(CONST Dir : STRING ; Left,Top,Width,Height : INTEGER) : IWebBrowserApp; BEGIN Result:=OpenFolder(Dir); IF Assigned(Result) THEN BEGIN Result.Left:=Left; Result.Top:=Top; Result.Width:=Width; Result.Height:=Height END END; FUNCTION OpenFolderAt(CONST Dir : STRING ; CONST Rect : TRect) : IWebBrowserApp; BEGIN Result:=OpenFolderAt(Dir,Rect.Left,Rect.Top,Rect.Width,Rect.Height) END; END. It is made for use with Delphi Tokyo 10.2.3 so if you use an earlier version (you didn't specify Delphi version in your question), you may need to adapt the USES list to match.
Why I cannot find window?
I use this example to send a string between two applications. When I press the Send button for the first time, the string is sent to the Receiver, but only a part of the string is received. When I press the Send button for the second time, I get "Window not found!". The window is right there on screen. Why it works when I press the button the first time, but not the second time? This is the sender: procedure TfrmSender.SendString; var stringToSend : string; copyDataStruct : TCopyDataStruct; begin Caption:= 'Sending'; stringToSend := 'About - Delphi - Programming'; copyDataStruct.dwData := 12821676; //use it to identify the message contents copyDataStruct.cbData := 1 + Length(stringToSend) ; copyDataStruct.lpData := PChar(stringToSend); SendData(copyDataStruct) ; end; procedure TfrmSender.SendData(CONST copyDataStruct: TCopyDataStruct); VAR receiverHandle : THandle; res : integer; begin receiverHandle := FindWindow(PChar('TfrmReceiver'), PChar('frmReceiver')) ; if receiverHandle = 0 then begin Caption:= 'Receiver window NOT found!'; EXIT; end; res:= SendMessage(receiverHandle, WM_COPYDATA, Integer(Handle), Integer(#copyDataStruct)); if res= 0 then Caption:= 'Receiver window found but msg not hand'; end; And this is the receiver: procedure TfrmReceiver.WMCopyData(var Msg: TWMCopyData); VAR s : string; begin if Msg.CopyDataStruct.dwData = 12821676 then begin s := PChar(Msg.CopyDataStruct.lpData); msg.Result := 2006; //Send something back Winapi.Windows.Beep(800, 300); Caption:= s; end end;
To summarize the comments there are two errors 1) (See #Tom Brunberg) is that the length is set incorrectly which is why you only get part (about half? of the string) It should be copyDataStruct.cbData := sizeof( Char )*(Length(stringToSend) + 1 ); 2) The forms caption is being changed which invalidates the expression FindWindow(PChar('TfrmReceiver'), PChar('frmReceiver')) because the second parameter is the form's caption (in Delphi terminology)
One Step Installer
I'm looking for a way to create a one page installer in Inno Setup, just look at this screenshot: Can anyone please give me the codes for doing this? Or totally I would like to merge pages abilities in Inno Setup. For example merge Select directory page with Components page and etc
It's not easy to do by default. But it can be done, the following code produced a page like this one. [Setup] AppName=Test AppVersion=1.5 DefaultDirName={code:AppDir} ;Disable all of the default wizard pages DisableDirPage=yes DisableProgramGroupPage=yes DisableReadyMemo=yes DisableReadyPage=yes DisableStartupPrompt=yes DisableWelcomePage=yes ;May want this, after install. DisableFinishedPage=no [Messages] ButtonNext=Install [Files] Source:"e:\test.txt"; DestDir: "{app}" Source:"e:\test.txt"; DestDir: "{app}"; DestName: "test1.txt"; Check: Option1; Source:"e:\test.txt"; DestDir: "{app}"; DestName: "test2.txt"; Check: Option2; [Code] var MainPage : TWizardPage; edtFolderToInstall : TEdit; InstallLocation : String; Opt1, Opt2 : Boolean; ChkOption1 : TCheckBox; ChkOption2 : TCheckBox; function AppDir(Param: String): String; begin // Set Default if not set. if InstallLocation = '' then InstallLocation := ExpandConstant('{pf}') + 'test'; result := InstallLocation; end; function Option1 : Boolean; begin result := Opt1; end; function Option2 : Boolean; begin result := Opt2; end; procedure BrowseClick(Sender : TObject); var Dir : String; begin Dir := edtFolderToInstall.Text; if BrowseForFolder('Select Folder',Dir,false) then edtFolderToInstall.Text := Dir; end; procedure InitializeWizard(); var lblFolderToInstall : TLabel; btnFolderToInstall : TButton; begin MainPage := CreateCustomPage(wpWelcome,'Setup - Test App Name','This will install "Test App Name" to your computer'); lblFolderToInstall := TLabel.Create(MainPage); lblFolderToInstall.Parent := MainPage.Surface; lblFolderToInstall.Top := 10; lblFolderToInstall.Left := 10; lblFolderToInstall.Caption := 'If you would like to select a different folder, Click Browse.' edtFolderToInstall := TEdit.Create(MainPage); edtFolderToInstall.Parent := MainPage.Surface; edtFolderToInstall.Top := 25; edtFolderToInstall.Left := 10; edtFolderToInstall.Width := 250; edtFolderToInstall.Text := WizardDirValue; btnFolderToInstall := TButton.Create(MainPage); btnFolderToInstall.Parent := MainPage.Surface; btnFolderToInstall.top := 25; btnFolderToInstall.Left := 275; btnfolderToInstall.Caption := 'Browse...'; btnFolderToInstall.OnClick := #BrowseClick; ChkOption1 := TCheckBox.Create(MainForm); ChkOption1.Parent := MainPage.Surface; ChkOption1.Top := 50; ChkOption1.Left := 10; ChkOption1.Caption := 'Option 1'; ChkOption2 := TCheckBox.Create(MainForm); ChkOption2.Parent := MainPage.Surface; ChkOption2.Top := 75; ChkOption2.Left := 10; ChkOption2.Caption := 'Option 2'; end; function NextButtonClick(CurPageID: Integer): Boolean; begin result := True; // Next pressed, better make sure selected items are correct. if CurPageId = MainPage.ID then begin InstallLocation := edtFolderToInstall.Text; Opt1 := ChkOption1.Checked; Opt2 := ChkOption2.Checked; end; end; To pull this off, I use {code:AppDir} as the default directory. This tells InnoSetup to use the function AppDir to retrieve the installation directory. I then can set it using my custom dialog. Instead of using [Components] and/or [Tasks] I have to use Check in the [Files] Section.