Watch, Follow, &
Connect with Us

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


Welcome, Guest
Guest Settings
Help

Thread: Service going to No where


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


Permlink Replies: 3 - Last Post: Oct 10, 2016 11:04 AM Last Post By: Remy Lebeau (Te...
Donald Bossen

Posts: 81
Registered: 2/3/02
Service going to No where  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Oct 6, 2016 2:20 PM
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;
repeat
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);
Continue;
Msg := 'Unable to Connect to JBI Database Bad Ip or Connection Missing';
end
until ConnectionJBI.Connected;
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;
repeat
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;
Continue;
Msg := 'Unable to Connect to Prophet 21 Database Bad Ip or Connection Missing';
end;
until ConnectionActivant.Connected;
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 ConnectToSql(Msg) then
begin
repeat
try
ConnectionFedexData.Connected := True;
if ConnectionFedexData.Connected then
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
except
Continue;
end;
until ConnectionFedexData.Connected;
end; //ConnectToSql
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;
end;

end.
I posted this on ADO Database but I believe after testing the it getting lost in the time some where I have Delay set to 30. In the Debugger you can see it run the time about 11 or so times before it gets lost. It does not throw an exception. In the original Config I beleved it was hitting the database before it finished I looked at the Microsoft site on services and it said to CancelWaitableTimer(hTimer); the when done restart it with SetWaitableTimer.
Thanks In Advance
Sonald S. Bossen
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Service going to No where  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Oct 6, 2016 6:07 PM   in response to: Donald Bossen in response to: Donald Bossen
Donald wrote:

I posted this on ADO Database but I believe after testing the it
getting lost in the time some where I have Delay set to 30. In the
Debugger you can see it run the time about 11 or so times before it
gets lost. It does not throw an exception.

One thing I notice is that your OnExecute handler is calling ServiceThread.ProcessRequests()
with its WaitForMessage parameter set to True. If MsgWaitForMultipleObjectsEx()
ever returns that pending messages are waiting to be processed, your service
will stop working correctly after ProcessRequests() has processed them.
This is because ProcessRequests() will not exit until the service is stopped.
It will just keep waiting for more messages, and thus your service will
stop calling MsgWaitForMultipleObjectsEx() so the timer callback can do its
work.

To fix that, call ProcessRequests() with its WaitForMessage parameter set
to False instead.

Otherwise, stop using the OnExecute event altogether. Have the OnStart event
start a worker thread, and the OnStop event terminate it, and then have that
thread simply run a wait loop on the timer, doing its work whenever the timer
is signaled. Don't use a callback anymore.

I looked at the Microsoft site on services and it said to
CancelWaitableTimer(hTimer); the when done restart it with
SetWaitableTimer.

Only if you need to change the timer's interval, or otherwise stop the timer for a period of time that is longer than its remaining interval, such ass if you are going to perform a lengthy operation and want the timer to delay after the operation is finished.

--
Remy Lebeau (TeamB)
Donald Bossen

Posts: 81
Registered: 2/3/02
Re: Service going to No where  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Oct 10, 2016 9:32 AM   in response to: Remy Lebeau (Te... in response to: Remy Lebeau (Te...

To fix that, call ProcessRequests() with its WaitForMessage parameter set
to False instead.
I set this parameter to False and it worked for 5771 Times
Till it errored in the event log with "Service failed on execute: System Error. Code: 8. Not enough storage is available to process this command"
Any Suggestions on how to make it more memory efficient? (Its not going throw much of the ADO Code because the table I am Checking is not being up Dated)
Donald S. Bossen
Remy Lebeau (Te...


Posts: 9,447
Registered: 12/23/01
Re: Service going to No where  
Click to report abuse...   Click to reply to this thread Reply
  Posted: Oct 10, 2016 11:04 AM   in response to: Donald Bossen in response to: Donald Bossen
Donald wrote:

I set this parameter to False and it worked for 5771 Times

Till it errored in the event log with "Service failed on execute:
System Error. Code: 8. Not enough storage is available to process
this command"

"Service failed on execute" means an uncaught exception escaped the OnExecute
event handler. Nothing in your OnExecute handler itself is raising an exception,
and ProcessRequests() basically just runs a message pump and does not raise
any exceptions of its own (if an exception were raised in a TService event
handler in reply to an SCM message, ProcessRequests() catches it and logs
it to the Windows Event Log, and does not re-raise it). So, that leaves
your timer callback code as the most likely culprit of the exception.

--
Remy Lebeau (TeamB)
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02