Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: Using Service to work wih ADO tables


This question is not answered. Helpful answers available: 2. Correct answers available: 1.


Permlink Replies: 0 Threads: [ Previous | Next ]
Donald Bossen

Posts: 81
Registered: 2/3/02
Using Service to work wih ADO tables  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Oct 5, 2016 8:25 AM
Here is my code.
unit Main;

interface

uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, Registry, IniFiles, Data.DB, ADODB, ActiveX,
StStrL, Winapi.WinSvc;

const
SubKey : String = 'Source';
Key : String = 'PwCt';
sbKey : PWideChar = 'yawara';//192.168.1.117
Code : PWideChar = '8zeSHkbZ7kppDw0d4c5uA0C57MPi2Q4oAl2vyKENYo1s89HHZabfAAAf5OTTJS9W';
SERVICE_CONFIG_DESCRIPTION = 1;

type
LPFN_CSC2 = function(hService: SC_HANDLE; dwInfoLevel: DWORD; lpInfo: Pointer): BOOL; stdcall;
LPSERVICE_DESCRIPTIONA = ^SERVICE_DESCRIPTIONA;

SERVICE_DESCRIPTIONA = record
lpDescription: PAnsiChar;
end;
LPSERVICE_DESCRIPTIONW = ^SERVICE_DESCRIPTIONW;

SERVICE_DESCRIPTIONW = record
lpDescription: PWideChar;
end;

{$IFDEF UNICODE}
SERVICE_DESCRIPTION = SERVICE_DESCRIPTIONW;
LPSERVICE_DESCRIPTION = LPSERVICE_DESCRIPTIONW;
{$ELSE}
SERVICE_DESCRIPTION = SERVICE_DESCRIPTIONA;
LPSERVICE_DESCRIPTION = LPSERVICE_DESCRIPTIONA;
{$ENDIF}
TServiceFedexUpload = class(TService)
procedure ServiceCreate(Sender: TObject);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceAfterInstall(Sender: TService);
private
{ Private declarations }
IniCfg : String; // name of Config Ini
Delay : Integer;
hTimer : THandle;
ConnectionActivant : TADOConnection;
TblUps : TADODataSet;
TblCarr : TADODataSet;
TblClip : TADODataSet;
TblPick : TADODataSet;
ConnectionJBI : TADOConnection;
TblRank : TADODataSet;
TblUser : TADODataSet;
ConnectionFedexData : TADOConnection;
TblPkg : TADODataSet;
TblPkgT : TADODataSet;
Enabled : Boolean;
function ReadIniStr(Inifile,SubKey,Key : String; def : String = '') : String;
function ReadIniInt(Inifile,SubKey,Key : String; def : Integer = 0) : Integer;
function ReadIniBoolean(Inifile,SubKey,Key : String; def : Boolean = True) : Boolean;
procedure WriteIniInt(Inifile,SubKey,Key : String; val : Integer = 0);
function cGetDecodedText(value : AnsiString; sbKey: String) : String;
function IniGetDecodeText(SubKey,Key,sbKey: String) : String;
procedure WakeWindows;
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;

var
ServiceFedexUpload: TServiceFedexUpload;

implementation

{$R *.DFM}

uses IcDcFunctions;

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
ServiceFedexUpload.Controller(CtrlCode);
end;

function TServiceFedexUpload.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;

procedure UpdateServiceDescription(const ServiceName, Description : String);
var
hAdvApi32 : THandle;
lpChangeServiceConfig2 : LPFN_CSC2;
hManager, hService : SC_HANDLE;
bChanged : Boolean;
sd: SERVICE_DESCRIPTION;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
// attempt to use ChangeServiceConfig2() first.
//
// ChangeServiceConfig2() does not exist on NT4,
// so using dynamic loading to check for its existence

hAdvApi32 := LoadLibrary('advapi32.dll');
if hAdvApi32 <> 0 then
try
{$IFDEF UNICODE}
@lpChangeServiceConfig2 := GetProcAddress(hAdvApi32, 'ChangeServiceConfig2W');
{$ELSE}
@lpChangeServiceConfig2 := GetProcAddress(hAdvApi32, 'ChangeServiceConfig2A');
{$ENDIF}

if Assigned(lpChangeServiceConfig2) then
begin
hManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
if hManager <> 0 then
begin
bChanged := False;
hService := OpenService(hManager, PChar(ServiceName), SERVICE_CHANGE_CONFIG);
if hService <> 0 then
begin
FillChar(sd, SizeOf(sd), 0);
if Description <> '' then
sd.lpDescription := PChar(Description)
else
sd.lpDescription := ''; // do not use NULL here, must be
// an empty string or else the
// description will not be deleted
bChanged := lpChangeServiceConfig2(hService,SERVICE_CONFIG_DESCRIPTION, @sd);
CloseServiceHandle(hService);
end;
CloseServiceHandle(hManager);
if bChanged then Exit;
end;
end;
finally
FreeLibrary(hAdvApi32);
end;
end;
end;

function TServiceFedexUpload.cGetDecodedText(value : AnsiString; sbKey: String) : String;
var
Len : Integer;
begin
result := '';
Len := GetDecodedText(PAnsiChar(Value),PChar(sbKey),nil,0);
if Len = -1 then
raise Exception.CreateFmt('Unable to decode Key: %s\%s',[SubKey,Key]);
if Len > 0 then
begin
SetLength(Result,Len);
Len := GetDecodedText(PAnsiChar(Value),PChar(sbKey),PChar(result),Len);
if Len = -1 then
raise Exception.CreateFmt('Unable to decode Key: %s\%s',[SubKey,Key]);
end;
end;

function TServiceFedexUpload.IniGetDecodeText(SubKey,Key,sbKey: String) : String;
var
Value : AnsiString;
Len : Integer;
begin
result := '';
Value := ReadIniStr(IniCfg,SubKey,Key);
Len := GetDecodedText(PAnsiChar(Value),PChar(sbKey),nil,0);
if Len = -1 then
raise Exception.CreateFmt('Unable to decode Key: %s\%s',[SubKey,Key]);
if Len > 0 then
begin
SetLength(Result,Len);
Len := GetDecodedText(PAnsiChar(Value),PChar(sbKey),PChar(result),Len);
if Len = -1 then
raise Exception.CreateFmt('Unable to decode Key: %s\%s',[SubKey,Key]);
end;
end;

function TServiceFedexUpload.ReadIniStr(Inifile,SubKey,Key : String; def : String = '') : String;
var
ConfigIni : TIniFile;
begin
ConfigIni := TIniFile.Create(Inifile);
Try
with ConfigIni do
begin
result := Trim(ReadString(UpperCase(SubKey),UpperCase(Key),Def));
end;
Finally
ConfigIni.Free;
end;
end;

function TServiceFedexUpload.ReadIniInt(Inifile,SubKey,Key : String; def : Integer = 0) : Integer;
var
ConfigIni : TIniFile;
begin
ConfigIni := TIniFile.Create(Inifile);
Try
with ConfigIni do
begin
result := ReadInteger(UpperCase(SubKey),UpperCase(Key),def);
end;
Finally
ConfigIni.Free;
end;
end;

function TServiceFedexUpload.ReadIniBoolean(Inifile,SubKey,Key : String; def : Boolean = True) : Boolean;
var
ConfigIni : TIniFile;
begin
ConfigIni := TIniFile.Create(Inifile);
Try
with ConfigIni do
result := ReadBool(UpperCase(SubKey),UpperCase(Key),def);
Finally
ConfigIni.Free;
end;
end;

procedure TServiceFedexUpload.ServiceAfterInstall(Sender: TService);
begin
UpdateServiceDescription(Sender.Name, 'Upload Fedex Shippments to P21.');
end;

Procedure TServiceFedexUpload.WriteIniInt(Inifile,SubKey,Key : String; val : Integer = 0);
var
ConfigIni : TIniFile;
begin
ConfigIni := TIniFile.Create(Inifile);
Try
with ConfigIni do
begin
WriteInteger(UpperCase(SubKey),UpperCase(Key),val);
end;
Finally
ConfigIni.Free;
end;
end;

procedure TServiceFedexUpload.ServiceCreate(Sender: TObject);
var
IniDir : String; // Directory the Ini Stored in.
begin
IniDir := 'C:\Program Files (x86)\J&B Importers Inc\Services\UploadFedexService\';
IniCfg := IniDir + 'Config.ini';
end;

procedure TServiceFedexUpload.ServiceExecute(Sender: TService);
begin
while not ServiceThread.CheckTerminated do
begin
case MsgWaitForMultipleObjectsEx(1, hTimer, INFINITE, QS_ALLINPUT, MWMO_ALERTABLE) of
WAIT_OBJECT_0 + 1:
ServiceThread.ProcessRequests(True);

WAIT_FAILED:
begin
Win32ErrCode := GetLastError;
Exit;
end;
end;
end;
end;

procedure TimerCallback(IpArgToCompletionRoutine : Pointer; dwTimerLowValue,dwTimerHighValue : DWORD); stdcall;
begin
TServiceFedexUpload(IpArgToCompletionRoutine).WakeWindows;
end;

procedure TServiceFedexUpload.ServiceStart(Sender: TService; var Started: Boolean);
var
{$IFDEF DEBUG}
Ticks : DWORD;
{$ENDIF}
i64 : Int64;
function BuidConnectionString : WideString;
begin
result := 'Provider='+ReadIniStr(IniCfg,'SQL','Provider')+';';//SQLNCLI11.1';//SQLNCLI10.1;';
result := result + 'Persist Security Info='+ReadIniStr(IniCfg,'SQL','Persist Security Info')+';';//False;';
result := result + 'User ID='+ReadIniStr(IniCfg,'SQL','User ID')+';';//shithead;';
result := result + 'Password='+ReadIniStr(IniCfg,'SQL','Password')+';';//shithead;';
result := result + 'Initial Catalog='+ReadIniStr(IniCfg,'SQL','Initial Catalog')+';';//shithead;';"Fedex";';
result := result + 'Data Source='+ReadIniStr(IniCfg,'SQL','Data Source')+';';//\SQLEXPRESS;';
result := result + 'Auto Translate='+ReadIniStr(IniCfg,'SQL','Auto Translate')+';';//True;';
result := result + 'Packet Size='+ReadIniStr(IniCfg,'SQL','Packet Size')+';';//4096;';
result := result + 'Initial File Name='+ReadIniStr(IniCfg,'SQL','Initial File Name')+';';//"";';
end;
begin
Started := False;

{$IFDEF DEBUG}
Ticks := GetTickCount;
repeat
Sleep(100);
if IsDebuggerPresent then
Break;
ReportStatus;
until (GetTickCount - Ticks) >= 30000;
{$ENDIF}

CoInitialize(nil);
Win32ErrCode := GetLastError;
Delay := ReadIniInt(IniCfg,'Timer','Delay');
ConnectionActivant := TADOConnection.Create(Self);
ConnectionActivant.ConnectionString := '';
ConnectionActivant.LoginPrompt := False;
ConnectionActivant.KeepConnection := True;
ConnectionActivant.CommandTimeout := 0;
ConnectionActivant.ConnectionTimeout := 15;

TblCarr := TADODataSet.Create(Self);
TblCarr.Connection := ConnectionActivant;
TblCarr.CommandTimeout := 0;
TblCarr.CursorType := ctStatic;
TblCarr.CursorLocation := clUseClient;
TblCarr.LockType := ltReadOnly;

TblClip := TADODataSet.Create(Self);
TblClip.Connection := ConnectionActivant;
TblClip.CommandTimeout := 0;
TblClip.CursorType := ctKeyset;
TblClip.CursorLocation := clUseServer;
TblClip.LockType := ltOptimistic;

TblPick := TADODataSet.Create(Self);
TblPick.Connection := ConnectionActivant;
TblPick.CommandTimeout := 0;
TblPick.CursorType := ctStatic;
TblPick.CursorLocation := clUseClient;
TblPick.LockType := ltOptimistic;

ConnectionJBI := TADOConnection.Create(Self);
ConnectionJBI.ConnectionString := '';
ConnectionJBI.LoginPrompt := False;
ConnectionJBI.KeepConnection := True;
ConnectionJBI.CommandTimeout := 0;
ConnectionJBI.ConnectionTimeout := 15;

TblRank := TADODataSet.Create(Self);
TblRank.Connection := ConnectionJBI;
TblRank.CommandTimeout := 0;
TblRank.CursorType := ctStatic;
TblRank.CursorLocation := clUseClient;
TblRank.LockType := ltReadOnly;

TblUser := TADODataSet.Create(Self);
TblUser.Connection := ConnectionJBI;
TblUser.CommandTimeout := 0;
TblUser.CursorType := ctStatic;
TblUser.CursorLocation := clUseClient;
TblUser.LockType := ltReadOnly;

TblUps := TADODataSet.Create(Self);
TblUps.Connection := ConnectionJBI;
TblUps.CommandTimeout := 0;
TblUps.CursorType := ctStatic;
TblUps.CursorLocation := clUseClient;
TblUps.LockType := ltOptimistic;

ConnectionFedexData := TADOConnection.Create(Self);
ConnectionFedexData.ConnectionString := BuidConnectionString;//'Provider=SQLNCLI11.1;Integrated Security="";Persist Security Info=False;User ID=SA;Password=Tnuc1234;OLE DB Services=-2;Initial Catalog="Fedex";Data Source=WEST2\SQLEXPRESS;Initial File Name="";Packet Size=4096;Auto Translate=True;Server SPN=""';
ConnectionFedexData.LoginPrompt := False;
ConnectionFedexData.KeepConnection := True;
ConnectionFedexData.CommandTimeout := 0;
ConnectionFedexData.ConnectionTimeout := 0;
ConnectionFedexData.DefaultDatabase := 'Fedex';

TblPkg := TADODataSet.Create(Self);
TblPkg.Connection := ConnectionFedexData;
TblPkg.CommandTimeout := 0;
TblPkg.CursorType := ctStatic;
TblPkg.CursorLocation := clUseClient;
TblPkg.LockType := ltOptimistic;

TblPkgT := TADODataSet.Create(Self);
TblPkgT.Connection := ConnectionFedexData;
TblPkgT.CommandTimeout := 0;
TblPkgT.CursorType := ctStatic;
TblPkgT.CursorLocation := clUseClient;
TblPkgT.LockType := ltOptimistic;

hTimer := CreateWaitableTimer(nil,true,nil);
if hTimer = INVALID_HANDLE_VALUE then
begin
Win32ErrCode := GetLastError;
exit;
end;
Enabled := True;
i64 := -Delay * 10000000;
if (not SetWaitableTimer(hTimer, i64, 0, @TimerCallBack, Self, True)) then
begin
Win32ErrCode := GetLastError;
exit;
end;
Started := True;
end;

procedure TServiceFedexUpload.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
if hTimer <> INVALID_HANDLE_VALUE then
begin
CancelWaitableTimer(hTimer);
CloseHandle(hTimer);
end;

CoUninitialize;

Stopped := True;
end;

procedure TServiceFedexUpload.WakeWindows;
var
PickTicketNo : String;
OldPickTicketNo : String;
TrackNo : String;
svcType : String;
carrier_Name : String;
TranType : String;
Msg : ShortString;
PickOrder : String;
PckCnt : Integer;
LineCnt : Integer;
TotSvcChg : Currency;
TotChg : Currency;
i64 : Int64;
i : Integer;
function ConnectToSql(var Msg : ShortString) : Boolean;
var
Server : String;
DbAcc : Boolean;
cntStr : String;
Ok : Boolean;
procedure FlashTask(flash : Boolean);
var
FWinfo : TFlashWInfo;
begin
with FWinfo do
begin
cbSize := 20;
// hwnd := Application.Handle;
if Flash then
dwflags := FLASHW_ALL
else
dwflags := FLASHW_STOP;
ucount := 1;
dwtimeout := 0;
end;
FlashWindowEX(FWinfo);
end;
function ConnectToJBI(Server : String) : boolean;
var
cntStr : String;
begin
if not ConnectionJBI.Connected then
begin
ConnectionJBI.Connected := False;
CntStr := cGetDecodedText('kIxG88cBF66e85ZIvUBtFb6gUHx5IIfOd3bSAFYeX0tjNskXdLrXw7yWPaQO58V6',Code);
CntStr := CntStr + cGetDecodedText('USXyUvAAd2TRKLz74ktmB44B5Bfe5BMbiuEdjz7rshIZK6yeDz+rvbqGJFJ+SMuT8xk=',Code);
CntStr := CntStr + cGetDecodedText('Pr44eaVQpZ17UZSGARSU4MQkfKcpr90Yf6a1uHBYSQXKJnodkZSXl+ePfiYKBYdf3qP0LjnScGw0GRhUdL8=',Code);
CntStr := CntStr + cGetDecodedText('5zJwl6AzSK+RxT+ZF2blj0gd9UMNI7krIttA/18otz+j46xcFzSq15z7czI5euvu',Code);
if ReadIniBoolean(IniCfg,'Source','TestDb',False) then
CntStr := CntStr + cGetDecodedText('be4iSrvdKlLv2DKQkxCqTwpKQAW6NWnm+pWqkDSSz7JTn1pUs3a9RtR8O3tSubdL65k=',Code)//JBI2
else
CntStr := CntStr + cGetDecodedText('nItsfGBQD21EdjpiTpurqkaZI6B7xi8YpWQcKZLlwD5OUMr2Y5/XatC65IE4Sguz',Code);
CntStr := CntStr + cGetDecodedText('Kvzcffk1bplH/XNzLzuMI+EHVtfXCysFL8cFGsJ9gFg=',Code)+Server+';';
CntStr := CntStr + cGetDecodedText('Yylj/Sh6OBrtdBm09IFdDkxEqJZX9ds26FD8b4GIUVPnIkfbI2J8N77PHvpCQrqtF+05yw==',Code);
ConnectionJBI.ConnectionString := CntStr;
try
ConnectionJBI.Connected := True;
if ConnectionJBI.Connected then
begin
result := True;
FlashTask(False);
end
else
begin
result := False;
FlashTask(True);
Msg := 'Unable to Connect to JBI Database Bad Ip or Connection Missing';
end;
except
result := False; // Exception fired in connecting to JBI
FlashTask(True);
Msg := 'Unable to Connect to JBI Database Bad Ip or Connection Missing';
end
end
else
result := True; // Allready conected to JBI Database
end;
function SelectRank(Server : String) : boolean;
var
Sql : WideString;
begin
if ConnectToJbi(Server) then
begin
TblRank.Active := False;
Sql := ' select *';
Sql := Sql + ' from labels_rank_rates';
TblRank.CommandText := Sql;
TblRank.Active := True;
if TblRank.RecordCount > 0 then
begin
result := True;
FlashTask(False);
end
else
begin
result := False;
FlashTask(True);
Msg := 'Selection Failed For Login Info in JBI Table Count = 0';
end;
end
else
begin
FlashTask(True);
result := False;
end;
end;
begin
msg := '';
Ok := True;
if not ConnectionActivant.Connected then
begin
DbAcc := ReadIniBoolean(IniCfg,'Source','AcctDb',False);
if ReadIniStr(IniCfg,'Source','PwCt') = '' then
begin
server := PWideChar(ReadIniStr(IniCfg,'Source','Server'));
end
else
server := PWideChar(IniGetDecodeText('Source','Server','yawara'));
if Ok then
begin
if SelectRank(Server) then
begin
if Not ConnectionActivant.Connected then
begin
CntStr := 'Provider=SQLOLEDB.1;';
CntStr := CntStr + cGetDecodedText('L2e8TR0a6Roqn2N88k6POCqyTeYhoekqqD63cGPH5Ge10IZKL4Yi1y0pF0vgVD69',Code);//
CntStr := CntStr + cGetDecodedText('WaI2I1OtwD0yTMZTagbN4/t2PEY8/55UcQn+zeyCGro+iN/ZSlugL4o2xf/MstauO18=',Code);//
CntStr := CntStr + 'Persist Security Info=True;';
if DbAcc then
CntStr := CntStr + 'Initial Catalog='+TblRank.FieldByName('sql_database_accounting').AsString+';'
else
CntStr := CntStr + 'Initial Catalog='+TblRank.FieldByName('sql_database').AsString+';';
CntStr := CntStr + 'Data Source='+Server+';';
CntStr := CntStr + 'Extended Properties="";';
CntStr := CntStr + 'Use Procedure for Prepare=1;';
CntStr := CntStr + 'Auto Translate=True;';
CntStr := CntStr + 'Packet Size=4096;';
CntStr := CntStr + 'Workstation ID=DSBOSSEN;';
ConnectionActivant.ConnectionString := CntStr;
try
ConnectionActivant.Connected := True;
if ConnectionActivant.Connected then
begin
result := True;
end
else
begin
result := False;
Msg := 'Unable to Connect to Prophet 21 Database Bad Ip or Connection Missing';
end;
except
result := False;
Msg := 'Unable to Connect to Prophet 21 Database Bad Ip or Connection Missing';
end;
end
else
result := True;
end
else
result := False;
end
else
begin
msg := 'NewPassword has be canceled';
result := False;
end;
end
else
result := True; // we are still conected to the sql database
end;
function FindShipment(PickNo : String) : Boolean;
var
Sql : WideString;
begin
if PickNo <> '' then
begin
TblUps.Active := False;
Sql := 'SELECT *';
Sql := Sql + ' FROM Shipment_info (NOLOCK)';
Sql := Sql + ' WHERE pick_Ticket_no = '+PickNo;
TblUps.CommandText := Sql;
TblUps.Active := True;
if TblUps.RecordCount > 0 then
result := True
else
result := False;
end
else
result := False;
end;
function FindPickTicket(PickNo,TranType : String) : Boolean;
var
Sql : WideString;
begin
if UpperCase(TranType) = 'PICK TICKET' then
begin
if PickNo <> '' then
begin
TblPick.Active := False;
Sql := 'SELECT invoice_no';
Sql := Sql + ', carrier_id';
Sql := Sql + ', tracking_no';
Sql := Sql + ', pick_Ticket_no';
Sql := Sql + ' FROM oe_pick_ticket (NOLOCK)';
Sql := Sql + ' WHERE pick_Ticket_no = '+PickNo;
TblPick.CommandText := Sql;
TblPick.Active := True;
if TblPick.RecordCount > 0 then
result := True
else
result := False;
end
else
result := False;
end
else
result := False;
end;
function FindClipperTrack(TrackNo : String) : Boolean;
var
Sql : WideString;
Msg : ShortString;
begin
if ConnectToSql(Msg) then
begin
if TrackNo <> '' then
begin
TblClip.Active := False;
Sql := 'SELECT *';
Sql := Sql + ' FROM clippership_return_10004';// (NOLOCK)';
Sql := Sql + ' WHERE tracking_no = '''+TrackNo+'''';
TblClip.CommandText := Sql;
TblClip.Active := True;
if TblClip.Locate('Tracking_no',TrackNo,[loCaseInsensitive]) then
result := True
else
result := False;
end
else
result := False;
end
else
result := False;
end;
function FindClipperPick(PickTicket : String) : Boolean;
var
Sql : WideString;
Msg : ShortString;
begin
if ConnectToSql(Msg) then
begin
if TrackNo <> '' then
begin
TblClip.Active := False;
Sql := 'SELECT *';
Sql := Sql + ' FROM clippership_return_10004';// (NOLOCK)';
Sql := Sql + ' WHERE pick_ticket_no = '''+PickTicket+'''';
TblClip.CommandText := Sql;
TblClip.Active := True;
if TblClip.RecordCount > 0 then
result := True
else
result := False;
end
else
result := False;
end
else
result := False;
end;
function GetUnProcessed : Boolean;
var
Sql : WideString;
begin
TblPkg.Active := False;
Sql := 'SELECT *';
Sql := Sql + ' FROM packages';// (NOLOCK)';
Sql := Sql + ' WHERE processed <> ''Y''';
Sql := Sql + ' Order By billing_ref';
TblPkg.CommandText := Sql;
TblPkg.Active := True;
if TblPkg.RecordCount > 0 then
result := True
else
result := False;
end;
function GetShpTotals(BillingRef : String) : Integer;
var
Sql : WideString;
begin
TblPkgT.Active := False;
Sql := 'SELECT COUNT (*) as cnt';
Sql := Sql + ', Sum(service_charge) as TotSvcChg';
Sql := Sql + ', Sum(total_charge) as TotChg';
Sql := Sql + ' FROM packages';// (NOLOCK)';
Sql := Sql + ' WHERE billing_ref = '''+BillingRef+'''';
Sql := Sql + ' Group by billing_ref';
TblPkgT.CommandText := Sql;
TblPkgT.Active := True;
result := TblPkgT.FieldByName('Cnt').AsInteger;
end;
function GetTotal(BillingRef : String; var TotSvcChg,TotChg : Currency) : Integer;
var
Sql : WideString;
v : String;
cnt : Integer;
begin
TblPkgT.Active := False;
Sql := 'SELECT tracking_no';
Sql := Sql + ', service_charge';
Sql := Sql + ', total_charge';
Sql := Sql + ', void_flag';
Sql := Sql + ' FROM packages';
Sql := Sql + ' WHERE billing_ref = '''+BillingRef+'''';
Sql := Sql + ' Order By tracking_no';
TblPkgT.CommandText := Sql;
TblPkgT.Active := True;
TotSvcChg := 0;
TotChg := 0;
Result := 0;
Cnt := TblPkgT.RecordCount;
TblPkgT.First;
while not TblPkgT.Eof do
begin
v := Trim(TblPkgT.FieldByName('void_flag').AsString);
if Trim(TblPkgT.FieldByName('void_flag').AsString) = 'N' then
begin
TotSvcChg := TotSvcChg + TblPkgT.FieldByName('service_charge').AsCurrency;
TotChg := TotChg + TblPkgT.FieldByName('total_charge').AsCurrency;
inc(result);
end
else
begin
TotSvcChg := TotSvcChg - TblPkgT.FieldByName('service_charge').AsCurrency;
TotChg := TotChg - TblPkgT.FieldByName('total_charge').AsCurrency;
dec(result);
end;
TblPkgT.Next;
end;
end;
function FindCarrier(carrier : String) : Boolean;
var
Sql : WideString;
Msg : ShortString;
begin
if ConnectToSql(Msg) then
begin
if carrier <> '' then
begin
TblCarr.Active := False;
Sql := 'SELECT *';
Sql := Sql + ' FROM address (NOLOCK)';
Sql := Sql + ' WHERE id = '+carrier;
TblCarr.CommandText := Sql;
TblCarr.Active := True;
if TblCarr.RecordCount > 0 then
result := True
else
result := False;
end
else
result := False;
end
else
result := False;
end;
function ConvDate(Dt : String) : TDateTime;
var
sd,sm,sy : String; //'2006106'
d, m, y : word;
begin
if length(dt) = 8 then
begin
sy := Copy(Dt,1,4);
if isStrNumericL(sy,'1234567890') then
y := StrToInt(sy);
sm := copy(dt,5,2);
if isStrNumericL(sm,'1234567890') then
m := StrToInt(sm);
sd := copy(dt,7,2);
if isStrNumericL(sd,'1234567890') then
d := StrToInt(sd);
result := EncodeDate(y,m,d);
end
else
result := Date;
end;
function checkCurrency(Value : String) : Currency;
begin
if isStrNumericL(Value,'1234567890.') then
result := StrToFloat(Value)
else
result := 0.00;
end;
function checkInt(Value : String) : Integer;
begin
if isStrNumericL(Value,'1234567890') then
result := StrToInt(Value)
else
result := 1;
end;
function SetSvcType(Code : String) : String;
begin
if code = 'CPS' then
result := '112391'
else if code = 'EPS' then
result := '112439'
else if Code = 'ESS' then
result := '112440'
else if Code = 'NPS' then
result := '112441'
else if Code = 'PDS' then
result := '112442'
else if Code = 'SDS' then
result := '112443'
else
result := '112458';
end;
begin
ConnectionActivant.Connected := False;
CancelWaitableTimer(hTimer);
i := ReadIniInt(IniCfg,'Counter','Count');
// if Enabled then
begin
Enabled := False;
if ConnectToSql(Msg) then
begin
ConnectionFedexData.Connected := True;
if GetUnProcessed then
begin
LineCnt := 0;
OldPickTicketNo := '';
TblPkg.First;
while Not TblPkg.Eof do
begin
PickOrder := TblPkg.FieldByName('billing_ref').AsString;
PickTicketNo := copy(PickOrder,1,pos('-',PickOrder)-1);
if OldPickTicketNo = PickTicketNo then
Inc(LineCnt)
else
begin
OldPickTicketNo := PickTicketNo;
LineCnt := 1;
end;
if isStrNumericL(PickTicketNo,'1234567890') then
begin
TrackNo := Trim(TblPkg.FieldByName('tracking_no').AsString);
TranType := Trim(TblPkg.FieldByName('pick_ticket').AsString);
FindShipment(Trim(PickTicketNo));
SvcType := Trim(TblPkg.FieldByName('service_type').AsString);

TblUps.Insert;
TblUps.FieldByName('Pick_ticket_no').AsString := PickTicketNo;
PckCnt := GetTotal(PickOrder,TotSvcChg,TotChg);
TblUps.FieldByName('Tracking_no').AsString := TrackNo; //Tracking
TblUps.FieldByName('Package_weight').AsInteger := TblPkg.FieldByName('weight').AsInteger;//Weight
TblUps.FieldByName('package_count').AsInteger := PckCnt;
TblUps.FieldByName('Pickup_date').AsDateTime := TblPkg.FieldByName('pickup_date').AsDateTime;
TblUps.FieldByName('service_type').AsString := svcType;
TblUps.FieldByName('delete_Flag').AsString := TblPkg.FieldByName('void_flag').AsString;
TblUps.FieldByName('package_charge').AsCurrency := TblPkg.FieldByName('service_charge').AsCurrency;
TblUps.FieldByName('total_shipment_charge').AsCurrency := TotSvcChg;
TblUps.FieldByName('total_shipping_and_handling_charge').AsCurrency := TotChg;
TblUps.FieldByName('transaction_type').AsString := TranType;
TblUps.FieldByName('Saturday_delivery').AsString := 'N';
TblUps.Post;

if FindPickTicket(PickTicketNo,TranType) then
begin
if Trim(TblPkg.FieldByName('void_flag').AsString) = 'Y' then // Cancelled shipment flag
begin
if FindClipperPick(PickTicketNo) then
if TblPick.FieldByName('invoice_no').AsString = '' then
if TblClip.Locate('Tracking_no',TrackNo,[loCaseInsensitive]) then
begin
TblClip.Edit;
TblClip.FieldByName('Delete_flag').AsString := 'Y';
TblClip.Post;
if TblPick.FieldByName('Tracking_no').AsString = TrackNo then
begin
TblPick.Edit;
TblPick.FieldByName('Tracking_no').AsString := '**CANCELLED**';
TblPick.Post;
end;
end;
end
else
begin
if FindCarrier(svcType) then
carrier_Name := TblCarr.FieldByName('name').asString
else
carrier_Name := svcType;
if TblPick.Locate('pick_ticket_no',PickTicketNo,[]) then
begin
TblPick.Edit;
TblPick.FieldByName('carrier_id').AsString := svcType;
TblPick.FieldByName('Tracking_no').AsString := TrackNo;
TblPick.Post;
end;
if FindClipperTrack(TrackNo) then
TblClip.Edit
else
begin
TblClip.Insert;
TblClip.FieldByName('clippership_return_uid').AsInteger := TblUps.FieldByName('package_uid').AsInteger;
TblClip.FieldByName('pick_ticket_no').asString := PickTicketNo;
TblClip.FieldByName('date_created').AsDateTime := Date;
end;
TblClip.FieldByName('tracking_no').asString := TrackNo;
TblClip.FieldByName('package_weight').AsInteger := TblPkg.FieldByName('weight').AsInteger;
TblClip.FieldByName('order_count').AsInteger := PckCnt;
TblClip.FieldByName('shipped_date').asDateTime := TblPkg.FieldByName('pickup_date').AsDateTime;
TblClip.FieldByName('carrier_name').asString := carrier_Name;
TblClip.FieldByName('total_charge').AsCurrency := TblPkg.FieldByName('total_charge').AsCurrency;
TblClip.FieldByName('processed_flag').asString := 'N';
TblClip.FieldByName('delete_flag').asString := 'N';
TblClip.FieldByName('date_last_modified').asDateTime := Now;
TblClip.FieldByName('last_maintained_by').asString := 'Fedex';
TblClip.FieldByName('line_number').asInteger := LineCnt;
TblClip.FieldByName('package_surcharge').AsCurrency := 0.00;
TblClip.FieldByName('handling_charge_flag').asString := 'N';
TblClip.Post;
end;
end;
end;
TblPkg.Edit;
TblPkg.FieldByName('processed').AsString := 'Y';
TblPkg.Post;
TblPkg.Next;
end; //while Not TblPkg.Eof do
end; //GetUnProcessed
end; //ConnectToSql
end; // Enabled
inc(i);
WriteIniInt(IniCfg,'Counter','Count',i);
i64 := -Delay * 10000000;
if (not SetWaitableTimer(hTimer, i64,0, @TimerCallBack, Self, True)) then
begin
Win32ErrCode := GetLastError;
exit;
end;
Enabled := True;
end;

end.
It a peers to work fine on my develop machine. But when I move it to a work machine it will run the Waitabletimer a few times and just stop I do not know how to track this down.
Thanks In advance
Donald S. Bossen
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02