Why I cannot find window? - api

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)

Related

Does HelpNDoc Pascal Script support structures?

I am trying to create a structure:
MyTopic
TopicID : String;
HelpID : Integer;
I wanted to create an array of these structures so I could sort them.
I have tried using this type / record syntax but it is failing.
Update
I defined this type and procedure:
type
TMyTopicRecord = record
idTopic : String;
idContextHelp : integer;
End;
procedure GetSortedTopicIDs(aTopics : array of String; size : Integer);
var
aMyTopicRecords : array of TMyTopicRecord;
temp : TMyTopicRecord;
iTopic, i, j : Integer;
begin
// Init the array
SetLength(aMyTopicRecords, size);
// Fill the array with the existing topid ids.
// Get the context ids at the same time.
for iTopic := 0 to size - 1 do
aMyTopicRecords[iTopic].idTopic := aTopics[iTopic];
aMyTopicRecords[iTopic].idContextHelp := HndTopics.GetTopicHelpContext(aTopics[iTopic]);
// Sort the array on context id
for i := size-1 DownTo 1 do
for j := 2 to i do
if (aMyTopicRecords[j-1].idContextHelp > aMyTopicRecords[j].idContextHelp) Then
begin
temp := aMyTopicRecords[j-1];
aMyTopicRecords[j-1] := aMyTopicRecords[j];
aMyTopicRecords[j] := temp;
end;
// Rebuild the original array of topic ids
for iTopic := 0 to size - 1 do
aTopics[iTopic] := aMyTopicRecords[iTopic].idTopic;
end;
The procedure gets called in a loop of the parent function (code snipped):
function GetKeywordsAsHtml(): string;
var
aKeywordList: THndKeywordsInfoArray;
aAssociatedTopics: array of string;
nBlocLevel, nDif, nClose, nCurKeywordLevel, nCurKeywordChildrenCnt: Integer;
nCurKeyword, nCurKeywordTopic: Integer;
nCountAssociatedTopics: Integer;
sCurrentKeyword, sKeywordLink, sKeywordRelated: string;
sKeywordJsCaption: string;
begin
Result := '<ul>';
nBlocLevel := 0;
try
aKeywordList := HndKeywords.GetKeywordList(False);
for nCurKeyword := 0 to length(aKeywordList) - 1 do
begin
sCurrentKeyword := aKeywordList[nCurKeyword].id;
nCurKeywordLevel := HndKeywords.GetKeywordLevel(sCurrentKeyword);
nCurKeywordChildrenCnt := HndKeywords.GetKeywordDirectChildrenCount(sCurrentKeyword);
sKeywordLink := '#';
sKeywordRelated := '[]';
aAssociatedTopics := HndTopicsKeywords.GetTopicsAssociatedWithKeyword(sCurrentKeyword);
nCountAssociatedTopics := Length(aAssociatedTopics);
if nCountAssociatedTopics > 0 then
begin
GetSortedTopicIDs(aAssociatedTopics, nCountAssociatedTopics);
// Code snipped
end;
end;
finally
Result := Result + '</ul>';
end;
end;
The script compiled in the HelpNDoc internal editor with no issues. But when I go to actually build my HTML documentation I encounter a problem:
The HelpNDoc API is explained here.
Is there something wrong with my code?
I decided to go about it a different way and used a simpler technique:
procedure GetSortedTopicIDs(var aTopics : array of String; iNumTopics : Integer);
var
iTopic : Integer;
// List of output
aList: TStringList;
begin
// Init list
aList := TStringList.Create;
// Build a new array of "nnn x"
// - nnn is the help context id
// - x is the topid id
// Note: I know that the context ID values are within the range 0 - 200
for iTopic := 0 to iNumTopics - 1 do
// We pad the context id with 0. We could increase the padding width to
// make the script mre useful
aList.Add(Format('%0.3d %s', [
HndTopics.GetTopicHelpContext(aTopics[iTopic]),
aTopics[iTopic]
]));
// Now we sort the new array (which basically sorts it by context id)
aList.Sort;
// Update original array
for iTopic := 0 to iNumTopics - 1 do
// We ignore the "nnn " part of the string to get just the topic id
aTopics[iTopic] := copy(aList[iTopic],5, length(aList[iTopic])-4);
// Tidy up
aList.Free;
end;
This compiles and I get the sorted array of topic IDs at the end of it. So the pop-up help is now listed as I want.

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.

Access violation while calling a DLL function

I have the next unction on a DLL:
function PedirContraseña() : string;
var
clave, claveCodificada : string;
begin
clave := InputBox('Autenticación', 'Introduzca la clave de acceso', '');
claveCodificada := SHA256Hash(clave);
Result := claveCodificada;
end;
exports PedirContraseña;
It asks to the user for a password, then it applies the SHA256 hash and returns the result of this hash.
On the main application I have the following call:
function PedirContraseña() : string; external 'seguridad.dll';
procedure Tmenubodega.BitBtn1Click(Sender: TObject);
var
s : string;
begin
inherited;
s := PedirContraseña;
ShowMessage(s);
end;
The first time I click the button it works fine.
The second time it still works.
From now, each 2 clicks it will show an Access Violation exception on the dll (1 time does, next time doesn't, next time does, next time doesn't...)
I'm confused. What can I do?
Thank's in advance

How to Sort Sections on TMemIniFile

I am using TMemIniFile to store configuration and I need to sort the sections in alpha order.
For that I have created a descendant of TMemIniFile
TRWStudioMemIniFile = class(TMemIniFile)
public
procedure UpdateFile; override;
procedure GetSortedStrings(List: TStrings);
end;
{ TRWStudioMemIniFile }
procedure TRWStudioMemIniFile.GetSortedStrings(List: TStrings);
var
I, J: Integer;
Strings: TStrings;
begin
List.BeginUpdate;
try
Sections.Sort;
for I := 0 to Sections.Count - 1 do
begin
List.Add('[' + Sections[I] + ']');
Strings := TStrings(Sections.Objects[I]);
for J := 0 to Strings.Count - 1 do List.Add(Strings[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
end;
procedure TRWStudioMemIniFile.UpdateFile;
var
List: TStringList;
begin
List := TStringList.Create;
try
GetSortedStrings(List);
List.SaveToFile(FileName, Encoding);
finally
List.Free;
end;
end;
but it needs to have access to the Sections (actually FSections: TStringList, that is a private member of TMemIniFile)
I have created a Helper class to expose that member thru a property. However this behavior is not supported anymore in Delphi 10.1
I started copy/paste the TMemIniFile to my unit and after and endless process I am ending up making a copy of the entire System.IniFile, just to access the FSections.
My question is how to access that FSections member without need to duplicate everything from that unit just to gain visibility
OR is there another way that I can Sort the Sections before saving? (I am just calling the TStringList.Sort from FSections)
Rather than relying on type-casting and "cracking open" the private member, you can instead get the sections into your own TStringList using the inherited ReadSections() method, sort that list as needed, and then use the inherited ReadSectionValues() method to read the strings for each section:
var
sections: TStringList;
values: TStringList;
begin
sections := TStringList.Create;
try
ReadSections(sections);
sections.Sort;
values := TStringList.Create;
try
List.BeginUpdate;
try
for I := 0 to sections.Count - 1 do
begin
List.Add('[' + sections[I] + ']');
values.Clear; // Just in case
ReadSectionValues(sections[i], values);
for J := 0 to values.Count - 1 do
List.Add(values[J]);
List.Add('');
end;
finally
List.EndUpdate;
end;
finally
values.Free;
end;
finally
sections.Free;
end;
end;

Inno Setup ADO Connection for run sql query provides error

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!