Solved: PUSHed data: HOW TO write a service/application to accept

ASKER

Hi folks

Thanks so far.

The XML transmission is already happening, I just don't have anything in place yet to catch it. I've written CGI and ISAPI applications before - is there anything in particular I need to look out for? I'm happy at the moment simply to grab the XML and dump it into text files or a database for later process, I don't need to parse them on the spot.

Eddie Shipman

When I wrote that app, I used Blaine Southham's BRSHTTPServer to build a web server for testing.
http://www.torry.net/vcl/internet/serverside/brshttp.zip
It includes source code so you can modify it to suit your needs.

I modified it to intercept the XML and parse it into an Oracle DB.

Eddie Shipman

Here it is. This is a very old application (from 1999) that used Paradox
to store the data and a TrayIcon and TTImer to check the BD for new/changed
records. Then it would create an XML file of the changed/new records and
send them using ICS THTTPCli to a java servlet that took the data and inserted
it into and Oracle DB. The XML was formatted to match what Oracle was
expecting. The servlet returned results that needed to be parsed as well. Like
I said above, I used BRSHTTPServer to test/debug this and it worked great.
Hope this helps you figure out your solution.

unit uXMLSenderApp;
(*
Modifications: 10/7/1999 - ES
Catch null datetimes other than grdate

10/18/99 - ES
Fix minimizing problem when called from EConvert
See FormCreate.

10/19/1999 - ES
Catch grdate that has spaces

10/22/1999 - ES
Log Error messages to ErrorData.txt
and fix error msg lines.
*)
interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
MSXML_TLB, ExtCtrls, Db, DBTables, ComObj, HttpProt, Registry, ActiveX,
Menus, TrayIcon, Grids, DBGrids, StdCtrls, Buttons, ComCtrls, ExtPage,
FileCtrl, CheckLst;

const ServiceKey: PChar = '\SOFTWARE\ASI\EConnect';

type
TfrmDataPump = class(TForm)
Timer1: TTimer;
HttpCli1: THttpCli;
mnuMain: TMainMenu;
pmnuMain: TPopupMenu;
pmniCloseEConnect: TMenuItem;
pmniShowEConnect: TMenuItem;
pmniStartEConnect: TMenuItem;
pmniStopEConnect: TMenuItem;
pmniLogging: TMenuItem;
pmniLoggingOn: TMenuItem;
pmniLoggingOff: TMenuItem;
mniStartEConnect: TMenuItem;
mniStopEConnect: TMenuItem;
mniMinimizeEConnect: TMenuItem;
mniFile: TMenuItem;
mniCloseEConnect: TMenuItem;
TrayIcon1: TTrayIcon;
ExtPageControl1: TExtPageControl;
tsErrors: TTabSheet;
tsData: TTabSheet;
dbgLVL1DATA: TDBGrid;
StatusBar1: TStatusBar;
dbgLVL1ERROR: TDBGrid;
Panel1: TPanel;
bitbtnViewErrorList: TBitBtn;
tsLogs: TTabSheet;
memDebugLog: TMemo;
mniLogging: TMenuItem;
mniLoggingOn: TMenuItem;
mniLoggingOff: TMenuItem;
PopupMenu1: TPopupMenu;
SortAscending1: TMenuItem;
SortDescending1: TMenuItem;
SortNatural1: TMenuItem;
tmrSearch: TTimer;
N1: TMenuItem;
mniUpdateGridOn: TMenuItem;
mniUpdateGridOff: TMenuItem;
mniSetProxyAddress: TMenuItem;
N3: TMenuItem;
Panel2: TPanel;
bitbtnViewLVL1Data: TBitBtn;
edtLocate: TEdit;
rbLocateByName: TRadioButton;
rbLocateByID: TRadioButton;
DB1: TDatabase;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
procedure pmniCloseEConnectClick(Sender: TObject);
procedure pmniShowEConnectClick(Sender: TObject);
procedure pmniStartEConnectClick(Sender: TObject);
procedure pmniStopEConnectClick(Sender: TObject);
procedure bitbtnViewLVL1DataClick(Sender: TObject);
procedure HttpCli1RequestDone(Sender: TObject; RqType: THttpRequest;
Error: Word);
procedure mniMinimizeEConnectClick(Sender: TObject);
procedure mniLoggingOnClick(Sender: TObject);
procedure mniLoggingOffClick(Sender: TObject);
procedure bitbtnViewErrorListClick(Sender: TObject);
procedure tsErrorsEnter(Sender: TObject);
procedure tsLogsEnter(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure FormShow(Sender: TObject);
procedure SortAscending1Click(Sender: TObject);
procedure SortDescending1Click(Sender: TObject);
procedure SortNatural1Click(Sender: TObject);
procedure edtLocateKeyPress(Sender: TObject; var Key: Char);
procedure tmrSearchTimer(Sender: TObject);
procedure mniUpdateGridOnClick(Sender: TObject);
procedure mniUpdateGridOffClick(Sender: TObject);
procedure mniSetProxyAddressClick(Sender: TObject);
procedure tsErrorsExit(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
ReturnedList, ErrorList: TStringList;
DataOut: TMemoryStream;
DataIn: TMemoryStream;
paramDBType: Integer;
SentList: TStringList;
bStarted, bNeedDTD, bYesData, bErrors, bUseCDATA: Boolean;
sURL, sDTDPath, sEConDir: string;
sConfigURL, sProxyAddr, sProxyPort, sProxyUser, sProxyPwd: string;
iTimerInterval, iRetryCount, iNumRetries: Integer;
iNumRecsToSend: Integer;
oXMLDoc: OleVariant;
DebugFile: TextFile;
RETFile: TextFile;
ERRFile: TextFile;
sDebugFile: string;
Dir: string;
public
{ Public declarations }
procedure PostData(dOut: TMemoryStream);
procedure StoreReturnedData(ReturnedList: TStringList);
procedure LogErrorMsgs(ErrorList: TStringList);
procedure IntializeConfig;
function GetConfigInfo: Boolean;
function CountInErrorLog(iLocalNum: Integer): Integer;
function GetPath(Alias: string): string;
end;

var
frmDataPump: TfrmDataPump;

implementation

uses udmMain, uSort, uProxySettings;

{$R *.DFM}

procedure TfrmDataPump.FormCreate(Sender: TObject);
var
MyInfo: TStartUpInfo;
begin
GetStartUpInfo(MyInfo);
ShowWindow(Handle, MyInfo.wShowWindow);
end;

procedure TfrmDataPump.IntializeConfig;
var
reg: TRegistry;
sDBType, sParadoxAlias: string;
begin
// Determine the current registry value
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if (reg.OpenKey(ServiceKey, True)) then
begin
sDBType := reg.ReadString('Database Type');
paramDBType := 0; // Paradox using BDE
iTimerInterval := reg.ReadInteger('Timer Interval');
sParadoxAlias := reg.ReadString('ParadoxAlias');
iNumRecsToSend := reg.ReadInteger('NoRecordsToSend');
sURL := reg.ReadString('URL');
sDTDPath := reg.ReadString('DTDPath');
sConfigURL := reg.ReadString('ConfigURL');
bNeedDTD := reg.ReadBool('NeedDTD');
bUseCDATA := reg.ReadBool('UseCDATA');
iRetryCount := reg.ReadInteger('RetryCount');
sEconDir := GetPath('Web1st') + '\EConnect\';
if reg.ReadBool('UseProxy') then
begin
sProxyAddr := reg.ReadString('ProxyAddr');
sProxyPort := reg.ReadString('ProxyPort');
sProxyUser := reg.ReadString('ProxyUser');
sProxyPwd := reg.ReadString('ProxyPassword');
end
else
begin
sProxyAddr := '';
sProxyPort := '80';
sProxyUser := '';
sProxyPwd := '';
end;
HttpCli1.Proxy := sProxyAddr;
HttpCli1.ProxyPassword := sProxyPwd;
HttpCli1.ProxyPort := sProxyPort;
HttpCli1.ProxyUsername := sProxyuser;
reg.CloseKey;
end
else // Key doesn't exist...Set Defaults and write key
begin
Timer1.Interval := 300000; // 5 minute intervals
paramDBType := 0; // Paradox using BDE
reg.WriteString('Database Type', 'P');
reg.WriteString('DTDPath', GetPath('Web1st') + '\EConnect\Lvl1data.dtd');
reg.WriteString('ConfigURL', 'http://datapump.thepavement.com/servlet/GetConfig');
reg.WriteString('URL', 'http://datapump.thepavement.com/servlet/GetPost');
reg.WriteString('ParadoxAlias', 'WebForms');
reg.WriteBool('NeedDTD', False);
reg.WriteBool('UseProxy', False);
reg.WriteString('ProxyAddr', '');
reg.WriteString('ProxyPort', '');
reg.WriteString('ProxyUser', '');
reg.WriteString('ProxyPassword', '');
reg.WriteInteger('Timer Interval', 300000);
reg.WriteInteger('RetryCount', 1);
reg.WriteInteger('NoRecordsToSend', 50); // initially send only 50 records
reg.WriteBool('UseCDATA', False);
sEconDir := GetPath('Web1st') + '\EConnect\';
end;
DB1.AliasName := sParadoxAlias;
{
dmMain.BDEQuery.DatabaseName := sParadoxAlias;
dmMain.tblLVL1DATA.DatabaseName := sParadoxAlias;
dmMain.tblLVL1ERROR.DatabaseName := sParadoxAlias;
dmMain.BDEQuery2.DatabaseName := sParadoxAlias;
dmMain.qryLVL1DATA.DatabaseName := sParadoxAlias;
dmMain.qryLVL1ERROR.DatabaseName := sParadoxAlias;
}
finally
reg.Destroy;
end;
end;

procedure TfrmDataPump.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if bStarted then
pmniStopEConnectClick(Self);
Timer1.Enabled := False;
end;

procedure TfrmDataPump.Timer1Timer(Sender: TObject);
var
oRoot, oNode, oAttr, oChild, oPI, oXMLCDATASection: OleVariant;
iType, i, j, x, iCardNum, iLocalNum, size: Integer;
s, s2, sUploaded: string;
flag, bData: Boolean;
DTDSL: TStringList;
begin
// Flash if there are errors in the error list
if bErrors then
StatusBar1.Panels[1].Text := 'Errors in LVL1ERROR.DB';
StatusBar1.Panels[0].Text := 'Beginning Timer';
Application.ProcessMessages;
if mniLoggingOn.Checked then
begin
Append(DebugFile);
Writeln(DebugFile, '*****');
WriteLn(DebugFile, 'Starting Timer:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
LockWindowUpdate(memDebugLog.Handle);
memDebugLog.Lines.Clear;
memDebugLog.Lines.LoadFromFile(sDebugFile);
LockWindowUpdate(0);
end;
j := 0;
// temporarily set the shortdate format for Y2K.
if ShortDateFormat = 'M/d/yy' then
ShortDateFormat := 'm/d/yyyy';
Timer1.Interval := iTimerInterval;
Timer1.Enabled := False; // Turn the timer off so it doesn't
// come on when this code is running
// we've got records to roll back...we didn't get anything
// back from the server...
if (not bYesData) and (SentList.Count > 0) and (iNumRetries <= iRetryCount) then
begin
for i := 0 to Pred(SentList.Count) do
begin
dmMain.BDEQuery.SQL.Clear;
dmMain.BDEQuery.SQL.Text := 'Update LVL1DATA ' +
' Set PENDING = 1, ' +
' UPLOADED = NULL ' +
'Where LOCAL_NUM = ' + SentList.Strings[i];
dmMain.BDEQuery.ExecSQL;
end;
bYesData := True;
Inc(iNumRetries);
flag := False
end
else
flag := True;
// flag := GetConfigInfo; // when we get this built...Set a flag here
// for connectivity problems.

SentList.Clear;
if flag then
begin
bData := False;
// Check to see if Data is available
case paramDBType of
0: // BDE
begin
dmMain.BDEQuery.SQL.Clear;
dmMain.BDEQuery.SQL.Text := 'SELECT Count(*) FROM LVL1DATA ' +
' WHERE PENDING = 1 ' +
' and UPLOADED IS NULL';
dmMain.BDEQuery.Open;
i := dmMain.BDEQuery.Fields[0].AsInteger;
j := i;
if i > 0 then
begin
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Records To Send:' + IntToStr(i));
CloseFile(DebugFile);
end;
bData := True;
end
else
begin
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'No Records To Send');
CloseFile(DebugFile);
end;
end;
dmMain.BDEQuery.Close;
end;
end; // case
if bData then
begin
try
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Beginning XML Build:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
// Build the XML document
oXMLDoc := VarNull;
oXMLDoc := CreateOleObject('Microsoft.XMLDOM');
oRoot := oXMLDoc.CreateElement('ROWSET');
oXMLDoc.AppendChild(oRoot);
case paramDBType of
0: // Paradox
begin
dmMain.BDEQuery.SQL.Clear;
dmMain.BDEQuery.SQL.Text := 'SELECT CARDNUM, LOCAL_NUM FROM LVL1DATA ' +
' WHERE PENDING = 1 ' +
' and UPLOADED IS NULL ';
dmMain.BDEQuery.Open;
dmMain.BDEQuery.First;
x := 1;
{
iNumrecsToSend is read from the registry.
if it is 0 then it sends all records. j is
assigned in the routine that checks to see how many
records pending to send.
}
if iNumRecsToSend = 0 then
iNumRecsToSend := j;
while (x <= iNumRecsToSend) and (not dmMain.BDEQuery.EOF) do
begin
iCardNum := dmMain.BDEQuery.Fields[0].AsInteger;
oNode := oXMLDoc.CreateElement('ROW');
oXMLDoc.DocumentElement.AppendChild(oNode);
dmMain.BDEQuery2.SQL.Clear;
// Update the uploaded and modified timestamps
sUploaded := FormatDateTime('MM/DD/YYYY hh:nn:ss', Now);
dmMain.BDEQuery2.SQL.Text := 'UPDATE LVL1DATA ' +
' SET UPLOADED = ''' + sUploaded + ''', ' +
' MODIFIED = ''' + sUploaded + ''' ' +
' WHERE CARDNUM = ' + IntToStr(iCardNum);
dmMain.BDEQuery2.ExecSQL;
dmMain.BDEQuery2.Close;
dmMain.BDEQuery2.SQL.Clear;
// now select the record to parse the data into XML...
dmMain.BDEQuery2.SQL.Text := 'SELECT * FROM LVL1DATA ' +
' WHERE CARDNUM = :CARDNUM';
dmMain.BDEQuery2.ParamByName('CARDNUM').AsInteger := iCardNum;
dmMain.BDEQuery2.Open;
iLocalNum := dmMain.BDEQuery2.FieldByName('LOCAL_NUM').AsInteger;
// Keeping track of records sent for error tracking later
if (SentList.IndexOf(IntToStr(iLocalNum)) = -1) then
SentList.Add(IntToStr(iLocalNum));
// iterate through the fields list to build XML
for i := 0 to Pred(dmMain.BDEQuery2.Fields.Count) do
begin
oChild := oXMLDoc.CreateNode('element', dmMain.BDEQuery2.Fields[i].FieldName, '');
iType := Ord(dmMain.BDEQuery2.Fields[i].DataType);
case TFieldType(iType) of
ftString:
oChild.Text := dmMain.BDEQuery2.Fields[i].AsString;
ftInteger, ftWord, ftSmallint:
begin
if dmMain.BDEQuery2.Fields[i].AsInteger > 0 then
oChild.Text := IntToStr(dmMain.BDEQuery2.Fields[i].AsInteger)
else
oChild.Text := '';
end;
ftFloat, ftCurrency, ftBCD:
begin
if dmMain.BDEQuery2.Fields[i].AsFloat > 0 then
oChild.Text := FloatToStr(dmMain.BDEQuery2.Fields[i].AsFloat)
else
oChild.Text := '';
end;
ftBoolean: if dmMain.BDEQuery2.Fields[i].Value then
oChild.Text := 'True'
else
oChild.Text := 'False';
ftDate, ftDateTime:
begin
if dmMain.BDEQuery2.Fields[i].FieldName = 'DB001_GRDATE' then
begin
if (not dmMain.BDEQuery2.Fields[i].IsNull) or
(Length(Trim(dmMain.BDEQuery2.Fields[i].AsString)) > 0) then
oChild.Text := FormatDateTime('MM/DD/YYYY',
dmMain.BDEQuery2.Fields[i].AsDateTime)
else
oChild.Text := '';
end
else
// Catch Null datetimes other than GRDATE
// Forgot this...
if not dmMain.BDEQuery2.Fields[i].IsNull then
oChild.Text := FormatDateTime('MM/DD/YYYY hh:nn:ss',
dmMain.BDEQuery2.Fields[i].AsDateTime)
else
oChild.Text := '';
end;
ftTime:
if not dmMain.BDEQuery2.Fields[i].IsNull then
oChild.Text := FormatDateTime('hh:nn:ss',
dmMain.BDEQuery2.Fields[i].AsDateTime)
else
oChild.Text := '';
ftMemo:
begin
if bUseCDATA then
begin
oChild := oXMLDoc.createElement(dmMain.BDEQuery2.Fields[i].FieldName);
oChild.appendChild(
oXMLDoc.createCDATASection(dmMain.BDEQuery2.Fields[i].AsString));
end
else
oChild.Text := dmMain.BDEQuery2.Fields[i].FieldName;
end;
end; // case
oNode.AppendChild(oChild);
end; // for
Inc(x);
dmMain.BDEQuery.Next;
dmMain.BDEQuery2.Close;
end; // while not dmMain.BDEQuery.EOF
dmMain.BDEQuery.Close;
end; // 0
end; // case paramDBType
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Done Building XML:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
DataOut.Clear;
DataIn.Clear;
// usually, we will need a DTD
if not bNeedDTD then
begin
oPI := oXMLDoc.CreateProcessingInstruction('xml', 'version="1.0"');
// <?xml version="1.0" encoding="iso-8859-1"?>
oXMLDoc.InsertBefore(oPI, oXMLDoc.ChildNodes.Item[0]);
// Build String from oXMLDoc.XML
s := oXMLDoc.XML;
// for some reason, we need to delete the last two bytes.
Delete(s, Length(s) - 1, 2);
DataOut.Write(s[1], Length(s));
end
else
begin
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Adding DTD to XML:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
DTDSL := TStringList.Create;
DTDSL.LoadFromFile(sDTDPath);
DataOut.Seek(0, soFromBeginning);
DTDSL.SaveToStream(DataOut);
s := oXMLDoc.XML;
DataOut.Write(s[1], Length(s));
DataOut.Seek(0, soFromBeginning);
if mniLoggingOn.Checked then
begin
DTDSL.LoadFromStream(DataOut);
DTDSL.SaveToFile(sEconDir + 'Econnect.xml');
end;
DTDSL.Free;
end;
if Length(s) > 0 then // Check if some data to post
begin
DataOut.Seek(0, soFromBeginning);
PostData(DataOut);
end;
finally
oXMLDoc := VarNull;
oRoot := VarNull;
oNode := VarNull;
oChild := VarNull;
oPI := VarNull;
oAttr := VarNull;
ShortDateFormat := 'm/d/yy';
end; // Try
end; // if bData
end; // if flag
StatusBar1.Panels[0].Text := 'Timer1 Ended';
Application.ProcessMessages;
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Ending Timer:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
Timer1.Enabled := True;
end;

procedure TfrmDataPump.PostData(dOut: TMemoryStream);
var
s: string;
begin
ErrorList.Clear;
ReturnedList.Clear;
dOut.Seek(0, soFromBeginning);
HttpCli1.SendStream := dOut;
HttpCli1.Agent := 'ASI XML Sender';
HttpCli1.ContentTypePost := 'text/xml';
HttpCli1.RcvdStream := DataIn;
HttpCli1.URL := sURL;
try
StatusBar1.Panels[0].Text := 'Posting Data';
Application.ProcessMessages;
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Posting Http:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
bYesData := False;
HttpCli1.PostAsync;
except
// Log any error messages and headers
s := '0;' + HttpCli1.ReasonPhrase + ';' + DateTimeToStr(Now) + ';' +
IntToStr(HttpCli1.StatusCode);
ErrorList.Add(s);
LogErrorMsgs(ErrorList);
Exit;
end;
StatusBar1.Panels[0].Text := 'Exiting Out of PostData';
end;

procedure TfrmDataPump.StoreReturnedData(ReturnedList: TStringList);
var
i, j, x, z: Integer;
s, s1: string;
sErrMsg, sModified, sDB001_PIN, sEUserID: string;
begin
{ReturnedList Format:
Index 0 = LOCALNUM
Index 1 = DB001_CARDNUM
Index 2 = ERRORMSG
Index 3 = EUSERID
Index 4 = DB001_PIN
}
StatusBar1.Panels[0].Text := 'Storing Data';
Application.ProcessMessages;
x := 0;
if mniLoggingOn.Checked then
begin
Append(RETFile);
for i := 0 to Pred(ReturnedList.count) do
Write(RETFile, ReturnedList.Strings[i] + #13);
CloseFile(RETFile);
end;
case paramDBType of
0: // Paradox
begin
for i := 0 to (ReturnedList.Count div 5) - 1 do
begin
x := i * 5;
j := SentList.IndexOf(ReturnedList.Strings[x]);
if j > -1 then
begin
SentList.Delete(j);
if (Length(Trim(ReturnedList.Strings[x + 2])) > 0) then
//and
// (Pos('Student already exists', Trim(ReturnedList.Strings[x + 2])) = 0) then
begin
// There was an error message posted with this record
// so place the info in ErrorList.
// Post it to the error log and
s := ReturnedList.Strings[x] + ';' + ReturnedList.Strings[x + 2] + ';' + DateTimeToStr(Now) + ';' + '300';
ErrorList.Add(s);
end
else
begin
{
They are passing a '*' in the db001_cardnum field
when it is an updated record, otherwise it is a new
post.
}
if ReturnedList.Strings[x + 1] <> '*' then
begin
if Length(Trim(ReturnedList.Strings[x + 2])) = 0 then
sErrMsg := 'lvl1Data.ERRORMSG = '''', '
else
sErrMsg := 'lvl1Data.ERRORMSG = ''' + ReturnedList.Strings[x + 2] + ''', ';
sModified := 'lvl1Data.MODIFIED = ''' + FormatDateTime('MM/DD/YYYY hh:nn:ss', Now) + ''', ';
sDB001_PIN := 'lvl1Data.DB001_PIN = ''' + ReturnedList.Strings[x + 4] + ''', ';
sEUserID := 'lvl1Data.EUSERID = ''' + ReturnedList.Strings[x + 3] + '''';
dmMain.BDEQuery.SQL.Text := 'UPDATE LVL1DATA ' +
' SET lvl1Data.DB001_CARDNUM = ' + ReturnedList.Strings[x + 1] + ', ' +
sErrMsg +
sModified +
'lvl1Data.PENDING = 0, ' +
sDB001_PIN +
sEUserID +
' WHERE lvl1Data.LOCAL_NUM = ' + ReturnedList.Strings[x] +
' and lvl1Data.UPLOADED is not NULL ';
dmMain.BDEQuery.ExecSQL;
dmMain.BDEQuery.SQL.Text := 'UPDATE LVL1DATA ' +
' SET lvl1Data.DB001_CARDNUM = ' + ReturnedList.Strings[x + 1] + ', ' +
sErrMsg +
sModified +
sDB001_PIN +
sEUserID +
' WHERE lvl1Data.LOCAL_NUM = ' + ReturnedList.Strings[x] +
' AND UPLOADED is NULL';
end
else
begin
{
This is an update record. DB001_CARDNUM is passed
as * when it is an updated record and I just update
the errormsg field, if there is one, the modified field
and the pending field...
}
if Length(Trim(ReturnedList.Strings[x + 2])) = 0 then
sErrMsg := 'lvl1Data.ERRORMSG = '''', '
else
sErrMsg := 'lvl1Data.ERRORMSG = ''' + ReturnedList.Strings[x + 2] + ''', ';
dmMain.BDEQuery.SQL.Text := 'UPDATE LVL1DATA ' +
' SET lvl1Data.MODIFIED = ''' + FormatDateTime('MM/DD/YYYY hh:nn:ss', Now) + ''', ' +
sErrMsg +
'lvl1Data.PENDING = 0 ' +
' WHERE lvl1Data.LOCAL_NUM = ' + ReturnedList.Strings[x] +
' and lvl1Data.UPLOADED is not NULL ';
end;
dmMain.BDEQuery.ExecSQL;
end;
end // if
else
begin
// Not found in the SentList stringlist.
// Post it to the error log and
if (Pos('HTTP', ReturnedList.Strings[x]) > 0) or
(Pos('Content', ReturnedList.Strings[x]) > 0) then
ReturnedList.Delete(x)
else
begin
if ReturnedList.Count > 2 then
begin
if Length(ReturnedList.Strings[x + 2]) > 0 then
s := ReturnedList.Strings[x] + ';' + ReturnedList.Strings[x + 2] + ';' + DateTimeToStr(Now) + ';' + '301'
else
s := ReturnedList.Strings[x] + ';' + 'Not Found in Sent List' + ';' + DateTimeToStr(Now) + ';' + '301';
ErrorList.Add(s);
end; // if ReturnedList.Count > 2
end; // if (Pos('HTTP', ReturnedList.Strings[x]) > 0 )...
end; // if ReturnedList.Strings.IndexOf...
end; // for i := 0 to (ReturnedList.Count...
if SentList.Count > 0 then
begin
// More sent than returned
// Post it to the error log
for i := 0 to Pred(SentList.Count) do
begin
if (ReturnedList.Count > 2) and (ReturnedList.Count < SentList.Count) then
begin
if Length(ReturnedList.Strings[x + 2]) > 0 then
s := ReturnedList.Strings[x] + ';' + ReturnedList.Strings[x + 2] + ';' + DateTimeToStr(Now) + ';' + '302'
else
s := ReturnedList.Strings[x] + ';' + 'Sent more than Returned' + ';' + DateTimeToStr(Now) + ';' + '302';
ErrorList.Add(s);
end; // if ReturnedList.Count > 2
// Clear the Uploaded for this record
// So it can be sent again
dmMain.BDEQuery.SQL.Clear;
dmMain.BDEQuery.SQL.Text := 'Update LVL1DATA ' +
' Set PENDING = 1, ' +
' UPLOADED = NULL ' +
'Where LOCAL_NUM = ' + SentList.Strings[i];
dmMain.BDEQuery.ExecSQL;
end; // for
end; // if SentList.Count > 0
end; // 0
end; // case
if mniUpdateGridOn.Checked then
begin
Screen.Cursor := crSQLWait;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.DisableControls;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.DisableControls;
dmMain.qryLVL1DATA.Close;
dmMain.qryLVL1ERROR.Close;
dmMain.qryLVL1DATA.Open;
dmMain.qryLVL1ERROR.Open;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.EnableControls;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
bYesData := True;
StatusBar1.Panels[0].Text := 'Done Storing Data';
if ErrorList.Count > 0 then
LogErrorMsgs(ErrorList);
end;

procedure TfrmDataPump.LogErrorMsgs(ErrorList: TStringList);
function ReplaceStr(const S: string; C: Char; const Replace: string): string;
var
i: Integer;
begin
Result := '';
for i := Length(S) downto 1 do
if S[i] = C then
Result := Replace + Result
else
Result := S[i] + Result;
end;

var
i, iLocalNum, iSeverity: Integer;
s, sErrorMsg: string;
dErrorDate: TDateTime;
begin
if mniLoggingOn.Checked then
begin
Append(ERRFile);
for i := 0 to Pred(ErrorList.Count) do
Write(ERRFile, ErrorList.Strings[i] + #13);
CloseFile(ERRFile);
end;
StatusBar1.Panels[0].Text := 'Logging Error Records';
bErrors := True;
StatusBar1.Panels[1].Text := 'Errors in LVL1ERROR.DB';
for i := 0 to Pred(ErrorList.Count) do
begin
s := ErrorList.Strings[i];
iLocalNum := StrToInt(Trim(Copy(s, 1, Pos(';', s) - 1)));
s := Copy(s, Pos(';', s) + 1, Length(s));
sErrorMsg := Trim(Copy(s, 1, Pos(';', s) - 1));
s := Copy(s, Pos(';', s) + 1, Length(s));
dErrorDate := StrToDateTime(Trim(Copy(s, 1, Pos(';', s) - 1)));
s := Copy(s, Pos(';', s) + 1, Length(s));
iSeverity := StrToInt(s);
case paramDBType of
0: // BDE
begin
if CountInErrorLog(iLocalNum) = 0 then
// We are modifying the uploaded to null so it will be picked up again
// ONLY if the record is not already in the error database
// So we first add the record to the error database and then on the
// next error occurrance, it won't get inserted/updated.
begin
// Insert into lvl1error table
dmMain.BDEQuery2.SQL.Clear;
dmMain.BDEQuery2.SQL.Text := 'INSERT INTO LVL1ERROR ' +
' (LVL1DATA, ERRORMSG, ERRORDATE, SEVERITY) ' +
'values ' +
' (:LVL1DATA, :ERRORMSG, :ERRORDATE, :SEVERITY) ';
dmMain.BDEQuery2.ParamByName('LVL1DATA').AsFloat := iLocalNum;
dmMain.BDEQuery2.ParamByName('ERRORMSG').AsString := sErrorMsg;
dmMain.BDEQuery2.ParamByName('ERRORDATE').AsDateTime := dErrorDate;
dmMain.BDEQuery2.ParamByName('SEVERITY').AsFloat := iSeverity;
dmMain.BDEQuery2.Prepare;
dmMain.BDEQuery2.ExecSQL;
dmMain.BDEQuery2.Close;
// Now clear the uploaded so it will be sent again
dmMain.BDEQuery3.SQL.Clear;
dmMain.BDEQuery3.SQL.Text := 'UPDATE LVL1DATA ' +
' SET UPLOADED = NULL, ' +
' PENDING = 1, ' +
' ERRORMSG = :ERRORMSG ' +
' WHERE LOCAL_NUM = :LOCAL_NUM';
dmMain.BDEQuery3.ParamByName('LOCAL_NUM').AsInteger := iLocalNum;
dmMain.BDEQuery3.ParamByName('ERRORMSG').AsString := sErrorMsg;
dmMain.BDEQuery3.Prepare;
dmMain.BDEQuery3.ExecSQL;
dmMain.BDEQuery3.Close;
end; // if not IsInErrorLog(...
end; // 0
end; // case
end; // for
dmMain.BDEQuery3.UnPrepare;
dmMain.BDEQuery2.UnPrepare;
StatusBar1.Panels[0].Text := 'Done Logging Error Records';
if mniUpdateGridOn.Checked then
begin
Screen.Cursor := crSQLWait;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.DisableControls;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.DisableControls;
dmMain.qryLVL1DATA.Close;
dmMain.qryLVL1ERROR.Close;
dmMain.qryLVL1DATA.Open;
dmMain.qryLVL1ERROR.Open;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.EnableControls;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
end;

(*
Function to check to see if the particlar lvl1data.cardnum is in the
lvl1error table...
*)

function TfrmDataPump.CountInErrorLog(iLocalNum: Integer): Integer;
var
sSql: string;
i: Integer;
begin
Result := 0;
sSQL := 'SELECT Count(*) FROM LVL1ERROR ' +
' WHERE LVL1DATA = :CARDNUM';
case paramDBType of
0: // BDE
begin
dmMain.BDEQuery2.SQL.Clear;
dmMain.BDEQuery2.SQL.Text := sSQL;
dmMain.BDEQuery2.ParamByName('CARDNUM').AsInteger := iLocalNum;
dmMain.BDEQuery2.Open;
Result := dmMain.BDEQuery2.Fields[0].AsInteger;
dmMain.BDEQuery2.Close;
end;
end; // case
end;

(*
Function called each time to see if config parameters have changed...
*)

function TfrmDataPump.GetConfigInfo: Boolean;
var
s, s2: string;
DataIn, DataOut: TMemoryStream;
begin
StatusBar1.Panels[0].Text := 'Retrieving Config Info';
s := '*';
DataOut := TMemoryStream.Create;
DataIn := TMemoryStream.Create;
if Length(s) > 0 then // Check if some data to post
DataOut.Write(s[1], Length(s));
DataOut.Seek(0, soFromBeginning);
HttpCli1.SendStream := DataOut;
HttpCli1.Proxy := '';
HttpCli1.ProxyPort := '';
HttpCli1.Agent := 'ASI XML Sender';
HttpCli1.ContentTypePost := 'text/xml';
DataIn := TMemoryStream.Create;
HttpCli1.RcvdStream := DataIn;
// We can get the configuration parameters using this CGI
HttpCli1.URL := 'http://pippen.econnect.com/servlet/GetConfig';
try
HttpCli1.Post;
except
// Server problem
Result := False;
end;
// HTML error page returned from www server
if Pos('<head>', HttpCli1.RcvdHeader.Strings[0]) > 0 then
Result := False
else
Result := True;

// need a way to parse this info into the registry...
// gotta figure out the format first...
StatusBar1.Panels[0].Text := '';
end;

procedure TfrmDataPump.pmniCloseEConnectClick(Sender: TObject);
begin
if bStarted then
begin
if (ReturnedList <> nil) and (ReturnedList.Count > 0) then
ReturnedList.Free;
if (ErrorList <> nil) and (ErrorList.Count > 0) then
ErrorList.Free;
if (SentList <> nil) and (SentList.Count > 0) then
SentList.Free;
if DataOut <> nil then
DataOut.Free;
if DataIn <> nil then
DataIn.Free;
end;
dmMain.qryLVL1DATA.Active := False;
dmMain.qryLVL1ERROR.Active := False;
Close;
end;

procedure TfrmDataPump.pmniShowEConnectClick(Sender: TObject);
begin
Application.Restore;
end;

procedure TfrmDataPump.pmniStartEConnectClick(Sender: TObject);
begin
if (ReturnedList <> nil) and (ReturnedList.Count > 0) then
ReturnedList.Free;
if (ErrorList <> nil) and (ErrorList.Count > 0) then
ErrorList.Free;
if (SentList <> nil) and (SentList.Count > 0) then
SentList.Free;
if DataOut <> nil then
DataOut.Free;
if DataIn <> nil then
DataIn.Free;
if mniUpdateGridOn.Checked then
begin
dmMain.qryLVL1DATA.Active := True;
dmMain.qryLVL1ERROR.Active := True;
end;
iNumRetries := 0;
bErrors := False;
bNeedDTD := False;
IntializeConfig;
Timer1.Interval := 5000; // initially set to 5 seconds to start...
ReturnedList := TStringList.Create;
ErrorList := TStringList.Create;
SentList := TStringList.Create;
DataOut := TMemoryStream.Create;
DataIn := TMemoryStream.Create;
bStarted := True;
bYesData := True;
Timer1.Enabled := True;
Application.Title := 'EConnectWR - Running';
frmDataPump.Caption := 'EConnectWR - Running';
end;

procedure TfrmDataPump.pmniStopEConnectClick(Sender: TObject);
begin
bStarted := False;
Application.Title := 'EConnectWR - Stopped';
frmDataPump.Caption := 'EConnectWR - Stopped';
Timer1.Enabled := False;
end;

procedure TfrmDataPump.bitbtnViewLVL1DataClick(Sender: TObject);
begin
Screen.Cursor := crSQLWait;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.DisableControls;
dmMain.qryLVL1DATA.Close;
dmMain.qryLVL1DATA.Open;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;

procedure TfrmDataPump.HttpCli1RequestDone(Sender: TObject; RqType: THttpRequest;
Error: Word);
var
s: string;
i: Integer;
begin
StatusBar1.Panels[0].Text := 'Receiving Data';
Application.ProcessMessages;
case RqType of
httpPOST:
begin
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Receiving Http:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
DataIn.Seek(0, soFromBeginning);
ReturnedList.LoadFromStream(DataIn);
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Lines Returned from stream:' + IntToStr(ReturnedList.Count));
CloseFile(DebugFile);
end;
// HTML error page returned from www server
if ((ReturnedList.Count > 0) and
((Pos('<head>', ReturnedList.Strings[0]) > 0) or
(Pos('java', ReturnedList.Strings[0]) > 0))) then
begin
if mniLoggingOn.Checked then
begin
Append(RETFile);
for i := 0 to Pred(ReturnedList.count) do
Write(RETFile, ReturnedList.Strings[i] + #13);
CloseFile(RETFile);
end;
ErrorList.Clear;
// We've got to abort this because servlet failed!!!!
if (Pos('java', ReturnedList.Strings[0]) > 0) then
begin
for i := 0 to Pred(ReturnedList.Count) do
begin
s := '0;' + ReturnedList.Strings[i] + ';' + DateTimeToStr(Now) + ';' + '999';
ErrorList.Add(s);
end;
end
else
begin
s := '0;' + ReturnedList.Strings[5] + ';' + DateTimeToStr(Now) + ';' + Copy(ReturnedList.Strings[1], 5, 3);
ErrorList.Add(s);
end;
LogErrorMsgs(ErrorList);
Exit;
end
else
begin
// Now Store the data that was returned and parsed into the StringList...
if mniLoggingOn.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Storing Data:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
end;
if ReturnedList.Count > 0 then
begin
StoreReturnedData(ReturnedList);
ReturnedList.Clear;
end;
if mniUpdateGridOn.Checked then
begin
Screen.Cursor := crSQLWait;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.DisableControls;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.DisableControls;
dmMain.qryLVL1DATA.Close;
dmMain.qryLVL1ERROR.Close;
dmMain.qryLVL1DATA.Open;
dmMain.qryLVL1ERROR.Open;
if ExtPageControl1.ActivePage = tsData then
dbgLVL1DATA.DataSource.DataSet.EnableControls;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;
end;
end;
end;
end;

procedure TfrmDataPump.mniMinimizeEConnectClick(Sender: TObject);
begin
Application.Minimize;
end;

procedure TfrmDataPump.mniLoggingOnClick(Sender: TObject);
begin
if bStarted then
begin
ShowMessage('You can not change Logging Options while the EConnectWR is running');
end
else
begin
tsLogs.TabVisible := True;
tsLogs.PageIndex := 2;
ExtPageControl1.ActivePage := tsData;
ExtPageControl1.ReAlignTabSheets(True);
AssignFile(RETFile, sEconDir + 'ReturnedData.txt');
ReWrite(RETFile);
CloseFile(RETFile);
AssignFile(ERRFile, sEconDir + 'ErrorData.txt');
ReWrite(ERRFile);
CloseFile(ERRFile);
sDebugFile := sEConDir + 'debugfile.txt';
AssignFile(DebugFile, sDebugFile);
if not mniLoggingOn.Checked then
begin
ReWrite(DebugFile);
WriteLn(DebugFile, 'Starting Logging:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
mniLoggingOn.Checked := True;
mniLoggingOff.Checked := False;
end;
end;
end;

procedure TfrmDataPump.mniLoggingOffClick(Sender: TObject);
begin
if bStarted then
begin
ShowMessage('You can not change Logging Options while the EConnectWR is running');
end
else
begin
tsLogs.TabVisible := False;
if not mniLoggingOff.Checked then
begin
Append(DebugFile);
WriteLn(DebugFile, 'Stopping Logging:' + FormatDateTime('hh:nn:ss', Now));
CloseFile(DebugFile);
mniLoggingOn.Checked := False;
mniLoggingOff.Checked := True;
end;
end;
end;

procedure TfrmDataPump.bitbtnViewErrorListClick(Sender: TObject);
begin
Screen.Cursor := crSQLWait;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.DisableControls;
dmMain.qryLVL1ERROR.Close;
dmMain.qryLVL1ERROR.Open;
if ExtPageControl1.ActivePage = tsErrors then
dbgLVL1ERROR.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;

procedure TfrmDataPump.tsErrorsEnter(Sender: TObject);
begin
dmMain.qryLVL1ERROR.Active := True;
bErrors := False;
StatusBar1.Panels[1].Text := '';
end;

function TfrmDataPump.GetPath(Alias: string): string;
function GetAliasPath(AliasStr: string): string;
var
AliasList,
ParamList: TStringList;
I: Integer;

function PathOfAlias(AList: TStringList): string;
var
I: Integer;
Found: Boolean;
begin
I := -1;
Found := False;
repeat
Inc(I);
Found := (Copy(AList[I], 1, 4) = 'PATH');
until (I = Pred(AList.count)) or Found;
if Found then
Result := Copy(AList[I], 6, Length(AList[I]) - 5);
end;

begin
AliasList := TStringList.Create;
ParamList := TStringList.Create;
try
Session.GetAliasNames(AliasList);
I := 0;
while (I < AliasList.Count) and
(UpperCase(AliasList[I]) <> UpperCase(AliasStr)) do
Inc(I);
if (I < AliasList.Count) then begin
Session.GetAliasParams(AliasList[I], ParamList);
Result := PathOfAlias(ParamList);
end else
Result := '';
finally
AliasList.Free;
ParamList.Free;
end;
end;

var
s: string;
i: Integer;
begin
s := GetAliasPath(Alias);
for i := Length(s) downto 0 do
begin
if S[i] = '\' then
Break;
end;
Result := Copy(s, 1, i - 1);
end;

procedure TfrmDataPump.tsLogsEnter(Sender: TObject);
begin
LockWindowUpdate(memDebugLog.Handle);
memDebugLog.Lines.Clear;
memDebugLog.Lines.LoadFromFile(sDebugFile);
LockWindowUpdate(0);
end;

procedure TfrmDataPump.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);

procedure DrawStatusPanel(Rect: TRect; Color: TColor; Text: string;
Alignment: Word);
var
PanelRect: TRect;
begin
PanelRect := Rect;
InflateRect(PanelRect, -2, 0);
StatusBar1.Canvas.Font.Color := Color;
DrawText(StatusBar1.Canvas.Handle, PChar(Text), -1, PanelRect,
DT_NOPREFIX or DT_SINGLELINE or DT_VCENTER or Alignment);
end;

begin
if Panel.Index = 1 then
begin
DrawStatusPanel(Rect, clRed, Panel.Text, DT_LEFT)
end;
end;

procedure TfrmDataPump.FormShow(Sender: TObject);
var
Dir: string;
begin
Dir := ExtractFilePath(ParamStr(0)) + 'PRIV';
if not DirectoryExists(Dir) then
CreateDir(Dir);
Session.PrivateDir := Dir;
if (ParamStr(1) = '/auto') and (not bStarted) then
begin
pmniStartEConnectClick(Self);
end;
if not bStarted then
begin
Application.Title := 'EConnectWR - Stopped';
frmDataPump.Caption := 'EConnectWR - Stopped';
end;
end;

procedure TfrmDataPump.SortAscending1Click(Sender: TObject);
var
i: Integer;
Grid: TDBGrid;
begin
Screen.Cursor := crSQLWait;
Grid := TDBGrid(PopupMenu1.PopupComponent);
Grid.DataSource.DataSet.DisableControls;
i := Grid.SelectedIndex;
with TGridSort.Create do
begin
GridSort(Grid, i, 'A');
Free;
end;
Grid.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;

procedure TfrmDataPump.SortDescending1Click(Sender: TObject);
var
i: Integer;
Grid: TDBGrid;
begin
Screen.Cursor := crSQLWait;
Grid := TDBGrid(PopupMenu1.PopupComponent);
Grid.DataSource.DataSet.DisableControls;
i := Grid.SelectedIndex;
with TGridSort.Create do
begin
GridSort(Grid, i, 'D');
Free;
end;
Grid.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;

procedure TfrmDataPump.SortNatural1Click(Sender: TObject);
var
i: Integer;
Grid: TDBGrid;
begin
Screen.Cursor := crSQLWait;
Grid := TDBGrid(PopupMenu1.PopupComponent);
Grid.DataSource.DataSet.DisableControls;
i := Grid.SelectedIndex;
with TGridSort.Create do
begin
GridSort(Grid, i, 'N');
Free;
end;
Grid.DataSource.DataSet.EnableControls;
Screen.Cursor := crDefault;
end;

procedure TfrmDataPump.edtLocateKeyPress(Sender: TObject; var Key: Char);
begin
tmrSearch.Enabled := FALSE;
tmrSearch.Enabled := TRUE;
end;

procedure TfrmDataPump.tmrSearchTimer(Sender: TObject);
var
sl: TStringList;
ds: TDataSet;
i: Integer;
begin
tmrSearch.Enabled := FALSE;
Screen.Cursor := crSQLWait;
ds := dbgLVL1DATA.DataSource.DataSet;
ds.DisableControls;
dmMain.qryLVL1DATA.Close;
sl := TStringList.Create;
sl.Assign(dmMain.qryLVL1DATA.SQL);
for i := 0 to pred(sl.Count) do
begin
if Pos('ORDER BY', UpperCase(sl.Strings[i])) > 0 then
sl.Delete(i);
if Pos('WHERE', UpperCase(sl.Strings[i])) > 0 then
sl.Delete(i);
end;
if rbLocateByName.Checked then
begin
sl.Add('WHERE UPPER(DB001_LNAME) LIKE :DB001_LNAME');
dmMain.qryLVL1DATA.SQL.Assign(sl);
dmMain.qryLVL1DATA.ParamByName('DB001_LNAME').AsString := UpperCase(edtLocate.Text) + '%';
end;
if rbLocateByID.Checked then
begin
sl.Add('WHERE DB001_ID LIKE :DB001_ID');
dmMain.qryLVL1DATA.SQL.Assign(sl);
dmMain.qryLVL1DATA.ParamByName('DB001_ID').AsString := edtLocate.Text + '%';
end;
dmMain.qryLVL1DATA.Prepare;
dmMain.qryLVL1DATA.Open;
ds.EnableControls;
Screen.Cursor := crDefault;
sl.Free;
end;

procedure TfrmDataPump.mniUpdateGridOnClick(Sender: TObject);
begin
if not mniUpdateGridOn.Checked then
begin
mniUpdateGridOn.Checked := True;
mniUpdateGridOff.Checked := False;
end;
end;

procedure TfrmDataPump.mniUpdateGridOffClick(Sender: TObject);
begin
if not mniUpdateGridOff.Checked then
begin
mniUpdateGridOn.Checked := False;
mniUpdateGridOff.Checked := True;
end;
end;

procedure TfrmDataPump.mniSetProxyAddressClick(Sender: TObject);
var
frmProxy: TfrmProxySettings;
reg: TRegistry;
begin
// set proxy address...
frmProxy := TfrmProxySettings.Create(Application);
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if (reg.OpenKey(ServiceKey, True)) then
begin
//frmProxy.edtIpAddress.ipAddress := reg.ReadString('ProxyAddr');
frmProxy.edtProxyPort.Text := reg.ReadString('ProxyPort');
frmProxy.edtProxyUserName.Text := reg.ReadString('ProxyUser');
frmProxy.edtProxyPassword.Text := reg.ReadString('ProxyPassword');
frmProxy.ShowModal;
end;
finally
reg.Destroy;
end;
if frmProxy.ModalResult = mrOK then
begin
reg := TRegistry.Create;
try
reg.RootKey := HKEY_LOCAL_MACHINE;
if (reg.OpenKey(ServiceKey, True)) then
begin
reg.WriteBool('UseProxy', True);
//reg.WriteString('ProxyAddr', frmProxy.edtIpAddress.ipAddress);
reg.WriteString('ProxyPort', frmProxy.edtProxyPort.Text);
reg.WriteString('ProxyUser', frmProxy.edtProxyUserName.Text);
reg.WriteString('ProxyPassword', frmProxy.edtProxyPassword.Text);
//sProxyAddr := reg.ReadString('ProxyAddr');
sProxyPort := reg.ReadString('ProxyPort');
sProxyUser := reg.ReadString('ProxyUser');
sProxyPwd := reg.ReadString('ProxyPassword');
HttpCli1.Proxy := sProxyAddr;
HttpCli1.ProxyPassword := sProxyPwd;
HttpCli1.ProxyPort := sProxyPort;
HttpCli1.ProxyUsername := sProxyuser;
end;
finally
reg.Destroy;
end;
end;
frmProxy.Free;
frmProxy := nil;
end;

procedure TfrmDataPump.tsErrorsExit(Sender: TObject);
begin
dmMain.qryLVL1ERROR.Active := False;
end;

end.

kenpem

ASKER

OK thanks guys, I was hoping for just a couple of pointers a gotcha-warnings.