Solved

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

Posted on 2006-06-26
6
540 Views
Last Modified: 2008-01-09
I use an online payment processor that can send ("push") status notifications to me by POSTing XML data to a URL aimed at a script/service on my server.

I'm not looking for an all-out lead-me-by-the-hand answer in this question, but if somebody could (a) give me a very brief idea of what is involved; and (b) point me at a good Delphi-relevant online resource that explains the nitty gritty mechanics, I'd appreciate it. Of course if somebody clarifies everything and steers me down a smooth road I'll probably up the points accordingly.

I use Delphi 7 (Enterprise Architect) and have no plans or desire to upgrade. On purely stubborn grounds, I refuse to use a Microsoft language to implement this solution!
0
Comment
Question by:kenpem
  • 3
  • 2
6 Comments
 
LVL 17

Accepted Solution

by:
geobul earned 100 total points
ID: 16986700
Hi,

Perhaps there is a better solution, so wait for comments from other experts also, but I would create a Delphi CGI app which will receive and process these XML posts at your http server. There are enough features/components in Delphi 7 to create both CGI and XML parts. For CGI you'll need to create a new project from File-New menu.

If you have any further questions on CGI issue, please ask. On XML issue ask also, of course, but I, personally, have no experience on that.

Regards, Geo
0
 
LVL 26

Assisted Solution

by:EddieShipman
EddieShipman earned 25 total points
ID: 16986807
I wrote a service application back in 1999 that that checked the existance of changed DB records and then transmitted
changed records as XML via HTTP to a java servlet. Let me see if I can find the source code.
0
 
LVL 4

Author Comment

by:kenpem
ID: 16990555
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.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 26

Expert Comment

by:EddieShipman
ID: 16993374
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.
0
 
LVL 26

Expert Comment

by:EddieShipman
ID: 16996021
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.

0
 
LVL 4

Author Comment

by:kenpem
ID: 17013767
OK thanks guys, I was hoping for just a couple of pointers a gotcha-warnings.
0

Featured Post

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

Suggested Solutions

Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
This video discusses moving either the default database or any database to a new volume.
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now