The xmldom usage in the package is as follows. I specify the next line to be added. But I can't find a solution on how to convert the line to xmldom format and add it.
vc_xml := '<'||cs_KEY_TAG||'>'|| pin_xml ||'</'||cs_KEY_TAG||'>';
parser := xmlparser.newParser;
xmlparser.parseclob(parser, vc_xml);
doc := xmlparser.getDocument(parser);
nl1 := xmldom.getElementsByTagName(doc, cs_KEY_TAG);
node := xmldom.item(nl1, 0);
nl2 := XMLDOM.getchildnodes(node);
len1 := xmldom.getLength(nl2);
FOR i in 0..len1-1 LOOP
node := xmldom.item(nl2, i);
nl3 := xmldom.getchildnodes(node);
len2 := xmldom.getLength(nl3);
FOR j in 0..len2 -1 LOOP
node := xmldom.item(nl3, j);
element := xmldom.makeElement(node);
node := xmldom.getFirstChild(node);
'<device_count>' || vs_d_count || '</device_count>' ->this is the line to add to the XML
Related
I have created a plc program in TwinCat and its saving data into csv file. But variable values are not updating. Only one value is repeating in csv file again and and again. Where I am doing wrong !!! Here is my code:
PROGRAM MAIN
VAR
// Open, close and write function block
fbFileOpen: FB_FileOpen;
fbFileClose: FB_FileClose;
fbFileWrite: FB_FileWrite;
fbFormatString2: FB_FormatString2;
fbGetTime: NT_GetTime;
//file variables
nState : INT := 0;
nCounter : LREAL :=0;
hFile: UINT;
sPathName : T_MaxString;
sWriteBuffer : STRING(5000);
sBufferTemp : STRING(1000);
bBufferTemp : BOOL;
sFormat : STRING(255);
//General Variables
bFill: BOOL;
bWrite: BOOL;
rTimestamp : LREAL;
rCurrent: LREAL;
rActPos: LREAL;
nTimeMilli: INT;
i: ULINT;
END_VAR
// Input values
//------------------------------------------------------------------------------------------------------------------------
rTimestamp:= ULINT_TO_LREAL(F_GetSystemTime());
nCounter:= nCounter+1;
rCurrent:= (nCounter+1)/100;
rActPos:= (nCounter+1)/200;
IF bFill THEN
FOR i :=0 TO 10000000 BY 1 DO
GVL.arrLog[i].rTimestamp := rTimestamp;
GVL.arrLog[i].rCurrent := rCurrent;
GVL.arrLog[i].rActPos := rActPos;
END_FOR
END_IF
// Function Block for Current Date and Time
//------------------------------------------------------------------------------------------------------------------------
IF fbGetTime.START AND NOT fbGetTime.BUSY THEN // simple flip flop for quick update of time
fbGetTime.START := FALSE;
ELSE
fbGetTime.START := TRUE;
END_IF
fbGetTime(
NETID:= ,
START:= ,
TMOUT:= ,
BUSY=> ,
ERR=> ,
ERRID=> ,
TIMESTR=> ); // The TIMESTR is used to get times and dates
//Case Statements that will handle sequence of writing
//------------------------------------------------------------------------------------------------------------------------
CASE nState OF
0: //Wait for write trigger
IF bWrite THEN
nState := 10;
bWrite := FALSE;
END_IF
10: //Create file path and file using date
sPathName := CONCAT('D:\Data\', WORD_TO_STRING(fbGetTime.TIMESTR.wYear));
sPathName := CONCAT(sPathName,'_');
sPathName := CONCAT(sPathName,WORD_TO_STRING(fbGetTime.TIMESTR.wMonth));
sPathName := CONCAT(sPathName,'_');
sPathName := CONCAT(sPathName,WORD_TO_STRING(fbGetTime.TIMESTR.wDay));
sPathName := CONCAT(sPathName,'_');
sPathName := CONCAT(sPathName,WORD_TO_STRING(fbGetTime.TIMESTR.wHour));
sPathName := CONCAT(sPathName,'_');
sPathName := CONCAT(sPathName,WORD_TO_STRING(fbGetTime.TIMESTR.wMinute));
sPathName := CONCAT(sPathName,'_Datalog.csv');
nState:= 20;
fbFileOpen.bExecute := TRUE;
20: //Open and wait for file to open
fbFileOpen.bExecute := TRUE;
IF NOT fbFileOpen.bBusy AND NOT fbFileOpen.bError THEN
fbFileOpen.bExecute := FALSE;
nState := 30;
END_IF
30: // Write contents in file
sWriteBuffer := 'Name, fCurrentScaled, fActPos $n';
sFormat := '%F, %F, %F $n';
nTimeMilli := WORD_TO_INT(fbGetTime.TIMESTR.wMilliseconds);
IF WORD_TO_STRING(fbGetTime.TIMESTR.wMinute) <> INT_TO_STRING(40) THEN
FOR nTimeMilli:= 0 TO 999 BY 1 DO
fbFormatString2(
pFormatString:= ADR(sFormat),
arg1:= F_LREAL(GVL.arrLog[i].rTimestamp),
arg2:= F_LREAL(GVL.arrLog[i].rCurrent),
arg3:= F_LREAL(GVL.arrLog[i].rActPos),
pDstString:= ADR(sWriteBuffer),
nDstSize:= SIZEOF(sWriteBuffer),
bError=> ,
nErrId=> );
bBufferTemp := CONCAT2(pSrcString1 := ADR(sWriteBuffer),
pSrcString2 := ADR(sBufferTemp),
pDstString:= ADR(sWriteBuffer),
nDstSize := SIZEOF(sWriteBuffer));
END_FOR
ELSE
nState := 40;
fbFileWrite.bExecute := TRUE;
END_IF
40: // Write data in file and Wait for writing in the file
fbFileWrite.bExecute := TRUE;
IF NOT fbFileWrite.bBusy AND NOT fbFileWrite.bError THEN
fbFileWrite.bExecute := FALSE;
nState := 50;
fbFileClose.bExecute := TRUE;
END_IF
50: // close file and wait for it to close
fbFileClose.bExecute := TRUE;
IF NOT fbFileClose.bBusy AND NOT fbFileClose.bError THEN
fbFileClose.bExecute := FALSE;
nState:= 0;
END_IF
END_CASE
// FunctionBlocks for OPEN, WRITE and CLOSE
//------------------------------------------------------------------------------------------------------------------------
fbFileOpen(
sNetId:= '', //The netID does not need to be specified for local system
sPathName:= sPathName,
nMode:= FOPEN_MODEAPPEND OR FOPEN_MODEPLUS, // Open empty file for both read and write. If file exists then its content are destroyed
ePath:= PATH_GENERIC,
bExecute:= ,
tTimeout:= ,
bBusy=> ,
bError=> ,
nErrId=> ,
hFile=> hFile); // This file handle will be same for all function blocks.
fbFileClose(
sNetId:= '',
hFile:= hFile,
bExecute:= ,
tTimeout:= ,
bBusy=> ,
bError=> ,
nErrId=> );
fbFileWrite(
sNetId:= '',
hFile:= hFile,
pWriteBuff:= ADR(sWriteBuffer), // A pointer is used to get address
cbWriteLen:= SIZEOF(sWriteBuffer), // Needs to know to size of string going to be written
bExecute:= ,
tTimeout:= ,
bBusy=> ,
bError=> ,
nErrId=> ,
cbWrite=> );
I have created a counter and divided into smaller portion so that I get several values for one second. Is there update syntax I am missing?
The problem would appear to be in your step 30. It looks like you're trying to execute the file write during the 40th minute of the hour, and the rest of the time you're assembling the string to be written. But you have the line sWriteBuffer := 'Name, fCurrentScaled, fActPos $n'; at the beginning of step 30, outside of the conditional block, so it will execute every time.
When the 40th minute occurs and you move to the next step to do the file write, you're still executing that line which will overwrite whatever was put into sWriteBuffer by fbFormatString2. I think the assignment statements for sWriteBuffer and sFormat should be inside the IF statement.
Also, I don't know why you have the line nTimeMilli := WORD_TO_INT(fbGetTime.TIMESTR.wMilliseconds); when you're using nTimeMilli as the index variable in your FOR loop. Is that supposed to be i?
You don't show how bWrite is activated, which starts the state machine, but what if it happened to be triggered right on the 40th minute? Your step 30 would go immediately into the file write without assembling the values to be written.
This is my PL/SQL error:
Error report
ORA-01422: exact fetch returns more than requested number of rows
ORA-06512: at line 67
00000 - "exact fetch returns more than requested number of rows"
*Cause: The number specified in exact fetch is less than the rows returned.
*Action: Rewrite the query or change number of rows requested
PL/SQL script:
DECLARE
cursor cur is (select distinct sor_ident
from CLEVA_OWNER_BE.f_polices, CLEVA_OWNER_BE.f_sit_objet_risque, CLEVA_OWNER_BE.f_produitass, cleva_owner_be.f_desc_stat_100, CLEVA_OWNER_BE.f_p_c_client, CLEVA_OWNER_BE.f_garantie_dyn
where pol_ident = sor_ptrpolid
and sor_ident = d100_ptrsorid
and bpcl_ident = pol_ptrclid
and pol_ptrpasid = pas_ident
and sor_ident = gad_ptrsorid
and pas_code_produit IN ('BFOV','BFOV2','BFOV5','BFOV6')
and BPCL_LIB24 = '1'
and d100_lib01 IN ('1','2','4','5','6')
and d100_lib09 > '1997'
and ( pol_codetat in ('1', '3', '6') or ( pol_codetat = '0' and pol_datcre > trunc ( sysdate - 183 ) ) )
and gad_code IN('RCVVY','RCLTY','RCVCT','RCHTY')
);
type tt_cur is varray(50) of cur%rowtype;
t_cur tt_cur;
type tt_cld is varray(50) of CLEVA_OWNER_BE.f_clause_dyn%rowtype;
t_cld tt_cld := tt_cld();
cld_key pls_integer;
v_ordre varchar2(3900);
v_desc varchar2(5000);
v_titre varchar2(5000);
BEGIN
t_cld.extend();
t_cld(1).CLD_IDENT := null;
t_cld(1).CLD_PTRSORID := null;
t_cld(1).CLD_TEXTE := null;
t_cld(1).CLD_ORDRE := null;
t_cld(1).CLD_CODE := 'RCVT7';
t_cld(1).CLD_SEQUENTIEL := null;
t_cld(1).CLD_SERVICES := null;
t_cld(1).CLD_INT_LOT_IMP := null;
t_cld(1).CLD_INT_LOT_EXP := null;
t_cld(1).CLD_LIBRE := 0;
t_cld(1).CLD_CHAPITRE := null;
t_cld(1).CLD_S_CHAPITRE := null;
t_cld(1).CLD_SS_CHAPITRE := null;
t_cld(1).CLD_TYPE := 2;
t_cld(1).CLD_TABLE := null;
t_cld(1).CLD_REFECHO := null;
t_cld(1).CLD_PTRSARID := null;
t_cld(1).CLD_TITRE := null;
t_cld.extend(49,1);
Line 67 select nvl( max(CLD_ident), 30000000) into cld_key
from CLEVA_OWNER_BE.f_clause_dyn
where CLD_ident between 30000000 and 49999999;
select TGA_ORDRE, tga_description, tga_titre into v_ordre, v_desc, v_titre
from cleva_owner_be.f_tarif_gar
where TGA_CODE = 'RCVT7';
OPEN cur;
LOOP
FETCH cur BULK COLLECT INTO t_cur LIMIT 50 ;
FOR i IN 1 .. t_cur.COUNT
LOOP
cld_key := cld_key + 1;
t_cld(i).CLD_IDENT := cld_key;
t_cld(i).CLD_PTRSORID := t_cur(i).sor_ident;
t_cld(i).CLD_TEXTE := v_desc;
t_cld(i).CLD_TITRE := v_titre;
t_cld(i).CLD_ORDRE := v_ordre;
END LOOP;
FORALL j IN 1..t_cur.COUNT
INSERT INTO CLEVA_OWNER_BE.f_clause_dyn VALUES t_cld(j);
COMMIT;
EXIT WHEN cur%NOTFOUND ;
END LOOP;
END
;
I am trying to create a structure:
MyTopic
TopicID : String;
HelpID : Integer;
I wanted to create an array of these structures so I could sort them.
I have tried using this type / record syntax but it is failing.
Update
I defined this type and procedure:
type
TMyTopicRecord = record
idTopic : String;
idContextHelp : integer;
End;
procedure GetSortedTopicIDs(aTopics : array of String; size : Integer);
var
aMyTopicRecords : array of TMyTopicRecord;
temp : TMyTopicRecord;
iTopic, i, j : Integer;
begin
// Init the array
SetLength(aMyTopicRecords, size);
// Fill the array with the existing topid ids.
// Get the context ids at the same time.
for iTopic := 0 to size - 1 do
aMyTopicRecords[iTopic].idTopic := aTopics[iTopic];
aMyTopicRecords[iTopic].idContextHelp := HndTopics.GetTopicHelpContext(aTopics[iTopic]);
// Sort the array on context id
for i := size-1 DownTo 1 do
for j := 2 to i do
if (aMyTopicRecords[j-1].idContextHelp > aMyTopicRecords[j].idContextHelp) Then
begin
temp := aMyTopicRecords[j-1];
aMyTopicRecords[j-1] := aMyTopicRecords[j];
aMyTopicRecords[j] := temp;
end;
// Rebuild the original array of topic ids
for iTopic := 0 to size - 1 do
aTopics[iTopic] := aMyTopicRecords[iTopic].idTopic;
end;
The procedure gets called in a loop of the parent function (code snipped):
function GetKeywordsAsHtml(): string;
var
aKeywordList: THndKeywordsInfoArray;
aAssociatedTopics: array of string;
nBlocLevel, nDif, nClose, nCurKeywordLevel, nCurKeywordChildrenCnt: Integer;
nCurKeyword, nCurKeywordTopic: Integer;
nCountAssociatedTopics: Integer;
sCurrentKeyword, sKeywordLink, sKeywordRelated: string;
sKeywordJsCaption: string;
begin
Result := '<ul>';
nBlocLevel := 0;
try
aKeywordList := HndKeywords.GetKeywordList(False);
for nCurKeyword := 0 to length(aKeywordList) - 1 do
begin
sCurrentKeyword := aKeywordList[nCurKeyword].id;
nCurKeywordLevel := HndKeywords.GetKeywordLevel(sCurrentKeyword);
nCurKeywordChildrenCnt := HndKeywords.GetKeywordDirectChildrenCount(sCurrentKeyword);
sKeywordLink := '#';
sKeywordRelated := '[]';
aAssociatedTopics := HndTopicsKeywords.GetTopicsAssociatedWithKeyword(sCurrentKeyword);
nCountAssociatedTopics := Length(aAssociatedTopics);
if nCountAssociatedTopics > 0 then
begin
GetSortedTopicIDs(aAssociatedTopics, nCountAssociatedTopics);
// Code snipped
end;
end;
finally
Result := Result + '</ul>';
end;
end;
The script compiled in the HelpNDoc internal editor with no issues. But when I go to actually build my HTML documentation I encounter a problem:
The HelpNDoc API is explained here.
Is there something wrong with my code?
I decided to go about it a different way and used a simpler technique:
procedure GetSortedTopicIDs(var aTopics : array of String; iNumTopics : Integer);
var
iTopic : Integer;
// List of output
aList: TStringList;
begin
// Init list
aList := TStringList.Create;
// Build a new array of "nnn x"
// - nnn is the help context id
// - x is the topid id
// Note: I know that the context ID values are within the range 0 - 200
for iTopic := 0 to iNumTopics - 1 do
// We pad the context id with 0. We could increase the padding width to
// make the script mre useful
aList.Add(Format('%0.3d %s', [
HndTopics.GetTopicHelpContext(aTopics[iTopic]),
aTopics[iTopic]
]));
// Now we sort the new array (which basically sorts it by context id)
aList.Sort;
// Update original array
for iTopic := 0 to iNumTopics - 1 do
// We ignore the "nnn " part of the string to get just the topic id
aTopics[iTopic] := copy(aList[iTopic],5, length(aList[iTopic])-4);
// Tidy up
aList.Free;
end;
This compiles and I get the sorted array of topic IDs at the end of it. So the pop-up help is now listed as I want.
This is the procedure to display the Customer Database:
procedure TfrmMain.mnuCustomerClick(Sender: TObject);
var
j: integer;
begin
con := TFDConnection.Create(nil);
query := TFDQuery.Create(con);
con.LoginPrompt := False;
con.Open('DriverID=SQLite;Database=C:\Users\katiee\Documents\Embarcadero\Studio\Projects\ProgramDatabase;');
query.Connection := con;
query.sql.Text := 'SELECT * FROM CustDatabase ORDER BY ID';
query.Open();
query.First;
sgdDatabases.colCount := 9;
sgdDatabases.FixedCols := 0;
for j := 0 to sgdDatabases.rowCount do
sgdDatabases.ColWidths[j] := 100;
sgdDatabases.Cells[0, 0] := 'ID';
sgdDatabases.Cells[1, 0] := 'First Name';
sgdDatabases.Cells[2, 0] := 'Last Name';
sgdDatabases.Cells[3, 0] := 'Address';
sgdDatabases.Cells[4, 0] := 'Town';
sgdDatabases.Cells[5, 0] := 'County';
sgdDatabases.Cells[6, 0] := 'Postcode';
sgdDatabases.Cells[7, 0] := 'Telephone No.';
sgdDatabases.Cells[8, 0] := 'E-Mail';
row := 1;
while not query.EOF do
begin
ID := query.FieldByName('ID').AsString;
firstname := query.FieldByName('First Name').AsString;
lastname := query.FieldByName('Last Name').AsString;
address := query.FieldByName('Address').AsString;
town := query.FieldByName('Town').AsString;
county := query.FieldByName('County').AsString;
postcode := query.FieldByName('Postcode').AsString;
telno := query.FieldByName('TelNo').AsString;
email := query.FieldByName('Email').AsString;
sgdDatabases.Cells[0, row] := ID;
sgdDatabases.Cells[1, row] := firstname;
sgdDatabases.Cells[2, row] := lastname;
sgdDatabases.Cells[3, row] := address;
sgdDatabases.Cells[4, row] := town;
sgdDatabases.Cells[5, row] := county;
sgdDatabases.Cells[6, row] := postcode;
sgdDatabases.Cells[7, row] := telno;
sgdDatabases.Cells[8, row] := email;
sgdDatabases.RowCount := sgdDatabases.RowCount + 1;
row := row + 1;
query.Next;
end;
end;
This is the procedure to display the Employee Database, which is basically identical except "SELECT * FROM EmplDatabase":
procedure TfrmMain.mnuEmployeeClick(Sender: TObject);
var
i: integer;
begin
con := TFDConnection.Create(nil);
query := TFDQuery.Create(con);
con.LoginPrompt := False;
con.Open('DriverID=SQLite;Database=C:\Users\kasio\Documents\Embarcadero\Studio\Projects\ProgramDatabase;');
query.Connection := con;
query.sql.Text := 'SELECT * FROM EmplDatabase ORDER BY ID';
query.Open();
query.First;
sgdDatabases.colCount := 9;
sgdDatabases.FixedCols := 0;
for i := 0 to sgdDatabases.RowCount do
sgdDatabases.ColWidths[i] := 100;
sgdDatabases.Cells[0, 0] := 'ID';
sgdDatabases.Cells[1, 0] := 'First Name';
sgdDatabases.Cells[2, 0] := 'Last Name';
sgdDatabases.Cells[3, 0] := 'Address';
sgdDatabases.Cells[4, 0] := 'Town';
sgdDatabases.Cells[5, 0] := 'County';
sgdDatabases.Cells[6, 0] := 'Postcode';
sgdDatabases.Cells[7, 0] := 'Telephone No.';
sgdDatabases.Cells[8, 0] := 'E-Mail';
row := 1;
while not query.EOF do
begin
ID := query.FieldByName('ID').AsString;
firstname := query.FieldByName('First Name').AsString;
lastname := query.FieldByName('Last Name').AsString;
address := query.FieldByName('Address').AsString;
town := query.FieldByName('Town').AsString;
county := query.FieldByName('County').AsString;
postcode := query.FieldByName('Postcode').AsString;
telno := query.FieldByName('TelNo').AsString;
email := query.FieldByName('Email').AsString;
sgdDatabases.Cells[0, row] := ID;
sgdDatabases.Cells[1, row] := firstname;
sgdDatabases.Cells[2, row] := lastname;
sgdDatabases.Cells[3, row] := address;
sgdDatabases.Cells[4, row] := town;
sgdDatabases.Cells[5, row] := county;
sgdDatabases.Cells[6, row] := postcode;
sgdDatabases.Cells[7, row] := telno;
sgdDatabases.Cells[8, row] := email;
sgdDatabases.RowCount := sgdDatabases.RowCount + 1;
row := row + 1;
query.Next;
end;
end;
When I run the program, I can open either of the databases on the first click, but then if I click again on either of the Customer or Employee buttons or try to change the database, the following error shows: "Project ProjectQuote.exe raised exception class EInvalidGridOperation with message 'Grid index out of range'".
If I delete the line
sgdDatabases.RowCount := sgdDatabases.RowCount + 1;
from the code, it displays both databases, but only shows the first four rows from the database even if there's more.
(I am aware of the uselessly repeated code and no I can't use anything else other than TStringGrid)
This line of your code looks wrong to me:
for j := 0 to sgdDatabases.rowCount do
sgdDatabases.ColWidths[j] := 100;
The [Index] of a StringGrid's ColWidths property is a column number, not a row number, so sgdDatabases.rowCount should have nothing to do with it. If, at the time the above code executes, the number of rows in the grid is greater than the number of columns, you will get an "Index out of range" error when the value of j reaches a value which represents an invalid column number.
In any case, even if that code were valid in that respect , there is an "off by one" error involving sgdDatabases.rowCount. The row numbers are zero-based, so it should be sgdDatabases.rowCount - 1 (assuming you were attempting to refer to a particular row by index, of course).
A more general point is that you can single-step through your code using the IDE's debugger; if you do that, you will see the exception occur when one particular line is executed, and that's the place to start looking for the cause. You should always include the location of the exception in your SO question, because readers should not have to guess this.
Usually, the IDE debugger will find the exception even if you don't single-step, as long as you go to
Tools | Debugger Options | Embarcadero Debuggers | Language Exceptions
in the IDE and check the checkbox Notify on Language Exceptions.
Btw, it would be better if you wrote a general-purpose routine to populate a StringGrid from a Dataset, maybe along the following lines:
procedure TForm1.DatasetToGrid(Dataset : TDataset; Grid : TStringGrid);
var
Col,
Row : Integer;
begin
Grid.RowCount := 1;
Row := 0;
// The following gives the column headers the names of the
// Dataset fields.
for Col := 0 to Dataset.FieldCount - 1 do
Grid.Cells[Col, Row] := Dataset.Fields[Col].FieldName;
Inc(Row);
Dataset.First;
while not Dataset.Eof do begin
for Col := 0 to Dataset.FieldCount - 1 do begin
// Oops! we don't need this Row := Grid.RowCount;
Grid.Cells[Col, Row] := DataSet.Fields[Col].AsString;;
end;
Dataset.Next;
Grid.RowCount := Grid.RowCount + 1;
Inc(Row);
end;
end;
One of the benefits of doing it that way is that all your mistakes are in one place, not duplicated in duplicated code, so if you fix them once, you're done.
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!