unit GenFns; interface uses SysUtils, db, dbtables, bde, classes, DBGrids, Dialogs, inifiles, FileCtrl; procedure SaveText(const s: string); procedure GetGSTRate; procedure UpdateBatchStatus(const nThisBatch, nStatus: LongInt); procedure LogOffUser(const sID:string); procedure DeleteTransactions(const sTable: string; const nThisBatch: LongInt; const sFieldName,sFieldType,sOperation,sFieldValue: string; var lSuccess:boolean); procedure XCopyToAdjustment(const nThisBatch:LongInt; const FieldValues: TStringList; var curAdjustExGST, curAdjustGST, curAdjustIncGST : Currency; var lSuccess: boolean); procedure DeleteFromDC(const nThisBatch:LongInt; const FieldValues: TStringList; const lSuccess: boolean); function Left( const S: string; const N: integer): string; function Right( const S: string; const N: integer): string; procedure QuickCopyTable(T: TTable; DestTblName: string; Overwrite: Boolean); function AccountFormat( const S: string ): string; function curSum(curValue1, curValue2: Currency) : Currency; function curFormat(curValue: Currency) : Currency; function CleanString( const S:string): string; function SingleSpaces( const S:string): string; function ConvertCDE2SDF( const S:string): string; function Curr2Str(const curValue: Currency): string; procedure GetOperatorReference(const Operator:string;var sID:string); function SecsToHrMinSec(const sTotalSecs: String): string; function YMD2DMY( const sDate: String ): string; procedure AddToTable(const sTableInsert: string; const sFields, sValues: TStringList); procedure GridTitleSort(Column: TColumn; slQuery: TStrings); procedure ProveInteger(var edtValue : string; var lValueAltered : boolean); procedure ProveWholeInteger(var edtValue : string; var lValueAltered : boolean); procedure ProveReal(var edtValue : string; var lValueIsReal : boolean); procedure ProveTimeString(var edtValue: string; var lValueIsTimeStr: boolean); function TestForTestDB: boolean; procedure UpdateBatchTotals(const BatchID: integer); function ConvertTimeToSecs(const InputTime: string): string; procedure AddMissingServiceID(const BatchID, TransactionTypeID: integer); { function UpdateFaultsTable(const nBatchID: integer;const sPeriod: string): boolean; } procedure Record_DataTaken(const nBatchID: integer); procedure GetParameter(const sParm:string; var sParmValue: string); procedure SetParameter(const sParm, sParmValue, sParmField: string); procedure FileQuery(const qryData:TQuery;const FileName: string ); function ReplacePartString(const sInputString, sOldStr, sNewStr : string): string; implementation uses ConstantValues, DataMod, DateFunctions, Main, MyMessage, Progress; // procedure SaveText(const s: string); var lContinue : boolean; sFile : string; SaveDialog : TSaveDialog; SundryTextFile : TextFile; q : TQuery; sTBSdirectory : string; begin q := TQuery.Create(nil); q.DatabaseName := 'dbPPdata'; q.SQL.Add('SELECT ParmText'); q.SQL.Add('FROM tParameter'); q.SQL.Add('WHERE Parm LIKE ''TBSdirectory'''); q.Open; if q.Eof then sTBSdirectory := '' else sTBSdirectory := q.FieldByName('ParmText').AsString; q.Close; q.Free; lContinue := (Length(sTBSdirectory)>0) and DirectoryExists(sTBSdirectory); if lContinue then begin sFile := sTBSdirectory + '\Out' + StandardDateString(Date) + '.txt'; end else begin // Ask the operator if the file is to be saved to file. SaveDialog := TSaveDialog.Create(nil); SaveDialog.Title := 'Save ID for Duplicate faults'; SaveDialog.FileName := 'Out' + StandardDateString(Date) + '.txt'; SaveDialog.Filter := 'Text Files (*.txt)|*.txt|All Files (*.*)|*.*'; SaveDialog.FilterIndex := 1; SaveDialog.DefaultExt := 'txt'; // Use the program directory as the default directory. SaveDialog.InitialDir := ExtractFilePath(ParamStr(0)); SaveDialog.Options := [ofHideReadOnly,ofNoReadOnlyReturn]; lContinue := SaveDialog.Execute; sFile := SaveDialog.FileName; SaveDialog.Free; sTBSdirectory := ExtractFileDir(sFile); end; if lContinue and DirectoryExists(sTBSdirectory) then begin // Open the required file. AssignFile( SundryTextFile, sFile ); try Rewrite( SundryTextFile ); // OK, now output the data to the file. Writeln( SundryTextFile, s ); finally // Done, now close the output file. CloseFile( SundryTextFile ); end; end; end; // SaveText. procedure GetGSTRate; var qryParam : TQuery; begin qryParam := TQuery.Create(MainForm); qryParam.DatabaseName := 'dbPPdata'; qryParam.SQL.Add('SELECT ParmNumber FROM tParameter'); qryParam.SQL.Add('WHERE Parm LIKE ''AppliedGSTRate'''); qryParam.Open; if not (qryParam.Bof and qryParam.Eof) and not VarIsNull(qryParam['ParmNumber']) then begin MAINFORM.GST_RATE := qryParam['ParmNumber']; end; qryParam.Close; qryParam.Free; // The next 4 lines are generic for applying GST when importing (RJC20050717). // Str(MAINFORM.GST_RATE:6:4, sGSTRate); // sGSTRate : string; // fGSTRate : Real; // fGSTRate := MAINFORM.GST_RATE; end; // GetGSTRate. procedure ProveInteger(var edtValue : string; var lValueAltered : boolean); var sValue : string; nLenValue : integer; sChar : string; lValueChanged : boolean; begin lValueChanged := False; sValue := Trim(edtValue); nLenValue := Length(sValue); if (nLenValue > 0) then begin sChar := Copy(sValue,nLenValue,1); if (Pos(sChar,'0123456789')=0) then begin if (nLenValue = 1) then edtValue := '' else edtValue := Copy(sValue,1,nLenValue-1); lValueChanged := True; end; end; // not ProveInteger(). lValueAltered := lValueChanged; end; // ProveInteger(). procedure ProveWholeInteger(var edtValue : string; var lValueAltered : boolean); var sValue : string; nLenValue : integer; nInt : integer; lValueChanged : boolean; begin lValueChanged := False; sValue := Trim(edtValue); nLenValue := Length(sValue); if (nLenValue > 0) then begin for nInt := 1 to nLenValue do if (Pos(Copy(sValue,nInt,1),'0123456789')=0) then begin if (nInt = 1) then edtValue := '' else edtValue := Copy(sValue,1,nInt-1); lValueChanged := True; break; end; end; // not ProveWholeInteger(). lValueAltered := lValueChanged; end; // ProveWholeInteger(). procedure ProveReal(var edtValue : string; var lValueIsReal : boolean); var sValue : string; nLenValue : integer; nInt : integer; lIsReal : boolean; begin lIsReal := True; sValue := Trim(edtValue); nLenValue := Length(sValue); if (nLenValue > 0) then begin for nInt := 1 to nLenValue do if (Pos(Copy(sValue,nInt,1),'0123456789.+-')=0) then begin // Failed the test, Invalid character found - end test. // if (nInt = 1) then edtValue := '' // else edtValue := Copy(sValue,1,nInt-1); lIsReal := False; break; end; end; // not ProveReal(). lValueIsReal := lIsReal; end; // ProveReal(). procedure ProveTimeString(var edtValue : string; var lValueIsTimeStr : boolean); var sValue : string; nLenValue : integer; nInt : integer; lIsTime : boolean; begin lIsTime := True; sValue := Trim(edtValue); nLenValue := Length(sValue); if (nLenValue > 0) then begin for nInt := 1 to nLenValue do if (Pos(Copy(sValue,nInt,1),'0123456789.+:')=0) then begin // Failed the test, Invalid character found - end test. // if (nInt = 1) then edtValue := '' // else edtValue := Copy(sValue,1,nInt-1); lIsTime := False; break; end; end; // not ProveReal(). lValueIsTimeStr := lIsTime; end; // lValueIsTimeStr(). procedure GridTitleSort(Column: TColumn; slQuery: TStrings); // Generic sorting routine. Called indirectly when the user clicks on a // column title of a database grid (eg a TRxDBGrid object). // Column contains the field to apply the sort, // slQuery is the previous SQL statement to be altered. // This routine will only act on a data source that is already sorted. // (Requires ORDER BY to be in the last line.) var nSpace : integer; SortString : string; SortFieldName : string; begin // Change sort order - eg:"ORDER BY BatchID, fieldname DESC". SortString := Trim(slQuery[slQuery.Count-1]); if (UpperCase(Copy(SortString,1,8)) = 'ORDER BY') and (Length(Column.FieldName) > 0) then begin nSpace := Pos(Column.FieldName,SortString); if (nSpace > 0) and ((Length(SortString)-nSpace+1) = Length(Column.FieldName)) then begin if (Right(SortString,5) = ' DESC') then SortString := Copy(SortString,1,Length(SortString) - 5) else SortString := SortString + ' DESC'; end else begin SortFieldName := ''; SortString := Copy(SortString,10,Length(SortString)-9); nSpace := Pos(',',SortString); while (nSpace > 0) do begin // Multiple Fields, retain first. SortFieldName := Trim(Copy(SortString,1,nSpace)); nSpace := Pos(',',Copy(SortString,nSpace+1,Length(SortString)-nSpace-1)); end; // while (nSpace > 0 do begin. if (Pos(Column.FieldName,SortFieldName) > 0) then begin if (Right(SortString,5) = ' DESC') then begin SortString := Copy(SortString,1,Length(SortString) - 5); end else begin SortString := SortString + ' DESC'; end; // if (Right(SortString,5) = ' DESC' then begin. end else begin SortString := SortFieldName +' '+ Column.FieldName; end; // if (Pos(Column.FieldName,SortFieldName) > 0) then begin. SortString := 'ORDER BY '+ SortString; end; // if (nSpace > 0) then begin. slQuery[slQuery.Count-1] := SortString; end; // if (UpperCase(Copy(SortString,1,8)) = 'ORDER BY') then begin. end; // procedure GridTitleSort(). procedure AddToTable(const sTableInsert: string; const sFields, sValues: TStringList); // Generic procedure to add the values to the named table. // All parameters must be strings. var qryAdd : TQuery; slStrings : TStringList; nItem, nTotal : integer; sResults : string; sThisTable : string; begin sThisTable := sTableInsert; nTotal := sFields.Count; if (sValues.Count = nTotal) then begin slStrings := TStringList.Create; slStrings.Add('INSERT INTO '+ sThisTable); sResults := '('; for nItem := 0 to nTotal-1 do begin sResults := sResults+ sFields[nItem] + ','; if (Length(sResults) > 60) and (nItem < nTotal-1) then begin slStrings.Add(sResults); sResults := ''; end; // if line > 60 chars. end; // for nItem := 0 to nTotal do begin. sResults := Copy(sResults, 1, Length(sResults)- 1); // Remove last comma. sResults := sResults + ')'; slStrings.Add(sResults); sResults := 'VALUES ('; for nItem := 0 to nTotal-1 do begin sResults := sResults+ sValues[nItem] + ','; if (Length(sResults) > 60) and (nItem < nTotal-1) then begin slStrings.Add(sResults); sResults := ''; end; // if line > 60 chars. end; // for nItem := 0 to nTotal do begin. sResults := Copy(sResults, 1, Length(sResults)- 1); // Remove last comma. sResults := sResults + ')'; slStrings.Add(sResults); qryAdd := TQuery.Create(MainForm); qryAdd.DatabaseName := 'dbPPdata'; qryAdd.SQL := slStrings; qryAdd.ExecSQL; qryAdd.Free; slStrings.Free; end else begin MessageDlg('Number of fields and data differ when'#13#10'appending to '''+ sThisTable+'''',mtWarning,[mbOk],0); end; // same number of strings. end; // procedure AddToTable(). procedure UpdateBatchStatus(const nThisBatch, nStatus: LongInt); var qryBA : TQuery; qryStringList : TStringList; nBatch : LongInt; nOutcome : integer; begin nBatch := nThisBatch; nOutcome := nStatus; qryStringList := TStringList.Create; qryBA := TQuery.Create(MainForm); qryBA.DatabaseName := 'dbPPdata'; qryStringList.Add('SELECT BatchStatusID FROM tBatch'); qryStringList.Add('WHERE (ID = '+ IntToStr(nBatch)+')'); qryBA.SQL := qryStringList; qryBA.Open; if not qryBA.Eof then begin // (Test avoids a possible error - but can't get here unless it exists). if (qryBA['BatchStatusID'] <> nOutcome) then begin // Update the tBatch table. qryStringList.Clear; qryStringList.Add('UPDATE tBatch'); qryStringList.Add('SET BatchStatusID = '+IntToStr(nOutcome)); qryStringList.Add('FROM tBatch'); qryStringList.Add('WHERE ID = '+ IntToStr(nBatch)); qryBA.Close; qryBA.SQL := qryStringList; qryBA.ExecSQL; end; // if (qryDC['BatchStatusID'] <> nOutcome) then. // Update the tBatchStatusHistory table. qryStringList.Clear; qryStringList.Add('INSERT INTO tBatchStatusHistory'); qryStringList.Add(' (BatchID, BatchStatusID, StatusChangeDate,UserID)'); qryStringList.Add(' VALUES ('+IntToStr(nBatch)+','+IntToStr(nOutcome)+ ','''+StandardDateString(Now)+''','+IntToStr(MainForm.OPERATORNUMBER)+')'); qryBA.Close; qryBA.SQL := qryStringList; qryBA.ExecSQL; end; // if qryDC.Eof and qryDC.Bof then. qryBA.Close; qryBA.Free; // Now update the list of viewable Batch numbers in tDataCollection // (in TabTransactionSummary). MainForm.SetBillingPeriodBatch; end; // UpdateBatchStatus(). function YMD2DMY( const sDate: String ): string; var SubString : string; begin SubString := Copy(sdate,7,2) + '/' + Copy(sdate,5,2) + '/' + Copy(sdate,1,4); Result := SubString; end; // YMD2DMY(). function SecsToHrMinSec( const sTotalSecs: String ): string; var sHour, sMin, sSec : string; nHour, nMin, nSec : integer; nTotalSecs : integer; SubString : string; begin // Initialise variables. nHour := 0; nMin := 0; // Convert the parameter to an integer. nTotalSecs := StrToInt(sTotalSecs); // Define the number of hours, minutes, seconds. if (nTotalSecs < 60) then nSec := nTotalSecs else begin nSec := nTotalSecs; nMin := Trunc(nTotalSecs / 60); nSec := nSec - (nMin * 60); if (59 < nMin) then begin nHour := Trunc(nMin / 60); nMin := nMin - (nHour * 60); end; end; // Now format the result string. sMin := Trim(IntToStr(nMin)); if (0 < nHour) then begin sHour := Trim(IntToStr(nHour)); if (nMin < 10) then sMin := '0' + sMin; end; sSec := Trim(IntToStr(nSec)); if (nSec < 10) then sSec := '0' + sSec; SubString := ''; if (nHour > 0) then SubString := sHour + ':'; SubString := SubString + sMin + ':' + sSec; Result := SubString; end; // SecsToHrMinSec(). procedure GetOperatorReference(const Operator:string;var sID:string); var sOp : string; // sUserID : string; qry : TQuery; // qryFunction : TQuery; sQueryString : TStringList; begin sOp := LowerCase(Trim(Operator)); if (Length(sOp)=0) or (sOp='unknown') then sID := '0' // Default. else begin sQueryString := TStringList.Create; qry := TQuery.Create(nil); qry.DatabaseName := 'dbPPdata'; sQueryString.Add('SELECT id FROM tUser'); sQueryString.Add('WHERE (UserLogin LIKE '''+sOp+''')'); qry.SQL := sQueryString; qry.Open; { // ************************************************************************* // ************ START DEVELOPER MODE ************************************* // ************************************************************************* if (qry.Bof and qry.Eof) then begin // Not in table (must be logging on), so add it. qry.Close; qry.SQL.Clear; qry.SQL.Add('INSERT INTO tUser (UserLogin,LastLoggedOn)'); qry.SQL.Add('VALUES ('''+sOp+''','''+ StandardDateString(Now) +''')'); qry.ExecSQL; qry.Close; qry.SQL.Clear; qry.SQL.Add('SELECT ID FROM tUser WHERE UserLogin = '''+sOp+''''); qry.Open; sUserID := IntToStr(qry.FieldByName('ID').AsInteger); // Not in the table - add it: // - grant full access to the program. qryFunction := TQuery.Create(nil); qryFunction.DatabaseName := 'dbPPdata'; qryFunction.SQL.Add('SELECT ID FROM tFunction'); qryFunction.Open; while not qryFunction.Eof do begin qry.Close; qry.SQL.Clear; qry.SQL.Add('INSERT INTO tUserFunction (UserID,FunctionID)'); qry.SQL.Add('VALUES ('+sUserID+','+IntToStr(qryFunction['id'])+')'); qry.ExecSQL; qryFunction.Next; end; // while not qryFunction.Eof do begin. qryFunction.Close; qryFunction.Free; end; // ************************************************************************* // ************** END DEVELOPER MODE ************************************* // ************************************************************************* } if (qry.Bof and qry.Eof) then sID := '0' // Default. else begin sID := IntToStr(qry.FieldByName('id').AsInteger); qry.Close; qry.SQL.Clear; qry.SQL.Add('UPDATE tUser'); qry.SQL.Add('SET LastLoggedOn =''' + StandardDateTimeString(Now) + ''''); qry.SQL.Add('WHERE ID = '+sID); qry.ExecSQL; end; qry.Close; qry.Free; sQueryString.Free; end; // no operator name given. end; // procedure GetOperatorReference(). procedure LogOffUser(const sID:string); var sUser : string; qry : TQuery; begin sUser := LowerCase(Trim(sID)); if (Length(sUser)>0) and not (sUser='0') then begin qry := TQuery.Create(nil); qry.DatabaseName := 'dbPPdata'; qry.SQL.Add('UPDATE tUser'); qry.SQL.Add('SET LastLoggedOff =''' + StandardDateTimeString(Now) + ''''); qry.SQL.Add('WHERE (ID = '+sID+')'); qry.ExecSQL; qry.Close; qry.Free; end; // if (Length(sUser)>0) and not (sUser='0') then begin. end; // procedure LogOffUser(). procedure DeleteTransactions(const sTable: string; const nThisBatch: LongInt; const sFieldName,sFieldType,sOperation,sFieldValue: string; var lSuccess:boolean); // const TestRevenueFlag,lRevenueFlag: boolean); var MessageForm : TMessagesForm; qry : TQuery; qryStringList : TStringList; sField : string; sFType : string; sValue : string; sAction : string; lSuccessful : boolean; begin MessageForm := TMessagesForm.Create(Nil); MessageForm.Msg.Caption := 'Updating the invoice data ...'; MessageForm.Show; MessageForm.Refresh; lSuccessful := True; sField := sFieldName; sFType := UpperCase(sFieldType); sValue := sFieldValue; sAction := sOperation; qryStringList := TStringList.Create; qryStringList.Add('DELETE'); qryStringList.Add('FROM '+sTable); qryStringList.Add('WHERE BatchID = '+IntToStr(nThisBatch)); if (Length(sField) > 0) and (Length(sFType) > 0) then begin // Test full data is available. if (Length(sValue) > 0) and (Length(sAction) > 0) then begin if (Pos(sFType,'DS')>0) then begin sValue := ''''+sValue+''''; // Add quote marks. end; // if (Pos(sFType,'DS')>0) then begin. qryStringList.Add('AND '+sField+' '+sAction+' '+sValue); end else lSuccessful := False; end else if (Length(sValue) = 0) then lSuccessful := True else lSuccessful := False; if lSuccessful then begin qry := TQuery.Create(nil); qry.DatabaseName := 'dbPPdata'; qry.SQL := qryStringList; qry.ExecSQL; qry.Close; qry.Free; end; // if lSuccessful then begin. qryStringList.Free; MessageForm.Close; MessageForm.Free; lSuccess := lSuccessful; end; // procedure DeleteTransactions(). procedure XCopyToAdjustment(const nThisBatch:LongInt; const FieldValues: TStringList; var curAdjustExGST, curAdjustGST, curAdjustIncGST : Currency; var lSuccess: boolean); // Two field values are in each string in FieldValues, separated by two '_' chars. // The values are for ServiceID and StatusID in the tDataCollection table. var MessageForm : TMessagesForm; qry : TQuery; qryStringList : TStringList; slSQL : TStringList; iString : integer; sServiceID : string; sStatusID : string; nComma : integer; nCount : integer; nSelect : integer; lSuccessful : boolean; begin MessageForm := TMessagesForm.Create(Nil); MessageForm.Msg.Caption := 'Transferring selected data ...'; MessageForm.Show; MessageForm.Refresh; lSuccessful := True; nCount := FieldValues.Count; slSQL := TStringList.Create; qryStringList := TStringList.Create; qryStringList.Add('FROM tDataCollection'); qryStringList.Add('WHERE (BatchID = '+IntToStr(nThisBatch)+')'); qryStringList.Add('AND ('); sServiceID := FieldValues.Strings[0]; nComma := Pos('||',sServiceID); sStatusID := Copy(sServiceID,nComma+2,Length(sServiceID)-nComma-1) +'))'; if nComma > 1 then begin sServiceID := ''''+Copy(sServiceID,1,nComma-1) +''')'; qryStringList.Add('((ServiceID LIKE '+sServiceID); end else begin qryStringList.Add('((ServiceID IS NULL)'); end; qryStringList.Add('AND (StatusID = '+sStatusID); for nSelect := 1 to nCount - 1 do begin sServiceID := FieldValues.Strings[nSelect]; nComma := Pos('||',sServiceID); sStatusID := Copy(sServiceID,nComma+2,Length(sServiceID)-nComma-1) +'))'; if nComma > 1 then begin sServiceID := ''''+Copy(sServiceID,1,nComma-1) +''')'; qryStringList.Add('OR ((ServiceID LIKE '+sServiceID); end else begin qryStringList.Add('OR ((ServiceID IS NULL)'); end; qryStringList.Add('AND (StatusID = '+sStatusID); end; // Now add a closing bracket to the WHERE statement. nSelect := qryStringList.Count - 1; qryStringList[nSelect] := qryStringList[nSelect]+')'; qry := TQuery.Create(nil); qry.DatabaseName := 'dbPPdata'; slSQL.Add('INSERT INTO tAdjustment'); slSQL.Add('SELECT *'); for iString := 0 to qryStringList.Count-1 do slSQL.Add(qryStringList[iString]); qry.SQL := slSQL; try qry.ExecSQL; except lSuccess := False; qry.Free; slSQL.Free; qryStringList.Free; end; slSQL.Clear; slSQL.Add('SELECT Sum(tDataCollection.AmountExGST) AS TotalExGST, '+ 'Sum(tDataCollection.GSTAmount) AS TotalGST,'); slSQL.Add(' Sum(tDataCollection.AmountIncGST) AS TotalIncGST'); for iString := 0 to qryStringList.Count-1 do slSQL.Add(qryStringList[iString]); qry.SQL := slSQL; qry.Open; if qry.Eof then begin curAdjustExGST := 0; curAdjustGST := 0; curAdjustIncGST := 0; lSuccessful := False; end else begin curAdjustExGST := qry.FieldByName('TotalExGST').AsCurrency; curAdjustGST := qry.FieldByName('TotalGST').AsCurrency; curAdjustIncGST := qry.FieldByName('TotalIncGST').AsCurrency; end; qry.Close; qry.Free; slSQL.Free; qryStringList.Free; MessageForm.Close; MessageForm.Free; lSuccess := lSuccessful; end; // procedure XCopyToAdjustment(). procedure DeleteFromDC(const nThisBatch:LongInt; const FieldValues: TStringList; const lSuccess: boolean); // Two field values are in each string in FieldValues, separated by 2x'|' chars. // The values are for ServiceID and StatusID in the tDataCollection table. // If FieldValues is empty then all data flushed where BatchID=nThisBatch. var MessageForm : TMessagesForm; qry : TQuery; qryStringList : TStringList; sServiceID : string; sStatusID : string; nComma : integer; nCount : integer; nSelect : integer; begin // Process may have been aborted in the calling routines - test first. if lSuccess then begin MessageForm := TMessagesForm.Create(Nil); MessageForm.Msg.Caption := 'Flushing tDataCollection data...'; MessageForm.Show; MessageForm.Refresh; nCount := FieldValues.Count; qryStringList := TStringList.Create; qryStringList.Add('DELETE'); qryStringList.Add('FROM tDataCollection'); qryStringList.Add('WHERE BatchID = '+IntToStr(nThisBatch)); if (FieldValues.Count > 0) then begin qryStringList.Add('AND ('); sServiceID := FieldValues.Strings[0]; nComma := Pos('||',sServiceID); sStatusID := Copy(sServiceID,nComma+2,Length(sServiceID)-nComma-1) +'))'; if nComma > 1 then begin sServiceID := ''''+Copy(sServiceID,1,nComma-1) +''')'; qryStringList.Add('((ServiceID LIKE '+sServiceID); end else begin qryStringList.Add('((ServiceID IS NULL)'); end; // if nComma > 1 then begin. qryStringList.Add('AND (StatusID = '+sStatusID); for nSelect := 1 to nCount - 1 do begin sServiceID := FieldValues.Strings[nSelect]; nComma := Pos('||',sServiceID); sStatusID := Copy(sServiceID,nComma+2,Length(sServiceID)-nComma-1) +'))'; if nComma > 1 then begin sServiceID := ''''+Copy(sServiceID,1,nComma-1) +''')'; qryStringList.Add('OR ((ServiceID LIKE '+sServiceID); end else begin qryStringList.Add('OR ((ServiceID IS NULL)'); end; // if nComma > 1 then begin. qryStringList.Add('AND (StatusID = '+sStatusID); end; // for nSelect := 1 to nCount - 1 do begin. // Now add a closing bracket to the WHERE statement. nSelect := qryStringList.Count - 1; qryStringList[nSelect] := qryStringList[nSelect]+')'; end; // if (FieldValues.Count > 0) then begin. qry := TQuery.Create(nil); qry.DatabaseName := 'dbPPdata'; qry.SQL := qryStringList; qry.ExecSQL; qry.Close; qry.Free; qryStringList.Free; MessageForm.Close; MessageForm.Free; end; // if lSuccessful then begin. end; // procedure DeleteFromDC(). // A function to remove any apostrophe from the passed string. // required to avoid confusing SQLServer that uses this char for string limits. function CleanString( const S: string) : string; var ans : string; nCharAt : integer; begin ans := S; nCharAt := Pos('''', ans); while (nCharAt > 0) do begin if (nCharAt = 1) then ans := Copy( ans,2,Length(ans)) else if (nCharAt = Length(ans)) then ans := Copy( ans,1,Length(ans)-1) else begin ans := Copy(ans,1,nCharAt-1) + Copy(ans,nCharAt+1,Length(ans)); end; nCharAt := Pos('''', ans); end; // while..do. Result := ans; end; // function CleanString(). function SingleSpaces( const S:string): string; var sPad: string; nSpace: integer; begin sPad := S; nSpace := Pos(' ',sPad); while (nSpace > 0) do begin sPad := Copy(sPad,1,nSpace) + Copy(sPad,nSpace+2,Length(sPad)-nSpace+1); nSpace := Pos(' ',sPad); end; // while..do. Result := sPad; end; // function SingleSpaces(). function ConvertCDE2SDF( const S:string ): string; // Converts a Comma-separated string into a String-delimited string. This // conversion allows TStringList.CommaText to be used to load strings. // Eg: converts the input string AES,AES01BLY,in,,N,Incoming Internal,20, // to "AES","AES01BLY","in","","N","Incoming Internal","20" var ans: string; begin ans := Trim(S); if (Length(ans) > 0) then begin if (Right(ans,1) = ',') then begin ans := Copy(ans,1,Length(ans)-1); end; ans := StringReplace(ans,'"','""',[rfReplaceAll]); // embedded " ans := StringReplace(ans,',','","',[rfReplaceAll]); // add " at commas ans := '"'+ ans +'"'; // lead and trail " end; Result := ans; end; // function ConvertCDE2SDF(). // Over-rides the default "ffGeneral" format, used to insert/update with SQL. function Curr2Str(const curValue: Currency): string; begin Result := CurrToStrF(curValue, ffFixed, 2); end; // function Curr2Str(). // General functions to correct rounding errors with the Currency field. function curSum(curValue1, curValue2: Currency) : Currency; begin Result := (Round(curValue1*100.0) + Round(curValue2*100.0))/100.00; end; // function curSum(). function curFormat(curValue: Currency) : Currency; begin Result := (Round(curValue*100.0)/100.00); end; // function curSum(). // Some general functions to simplify the transition from dBase to Delphi4. function Left( const S: string; const N: integer): string; // Returns the first N characters of string S. var ans : string; iOk : integer; begin ans := S; if N > Length(ans) then iOk := Length(ans) else iOk := N; SetLength( ans, iOk); Result := ans; end; // function Left(). function Right( const S: string; const N: integer): string; // Returns the last N characters of string S. var ans : string; i : word; iOk, iStart : integer; begin if N > Length(S) then iOk := Length(S) else iOk := N; SetLength( ans, iOk); iStart := Length(S) - iOk; for i := 1 to iOk do ans[i] := S[i+iStart]; Result := ans; end; // function Right(). procedure QuickCopyTable(T: TTable; DestTblName: string; Overwrite: Boolean); // Copies TTable T to an identical table with name DestTblName. // Will overwrite an existing table with name DestTblName if // Overwrite is True. var DBType: DBINAME; WasOpen: Boolean; NumCopied: Word; begin WasOpen := T.Active; // Save the table state; if (not Wasopen) then T.Open; // Ensure table is open. // Get the driver type string. Check(DbiGetProp(hDBIObj(T.Handle), drvDRIVERTYPE, @DBType, Sizeof(DBINAME), NumCopied)); // Copy the table. Check(DbiCopyTable(T.DBHandle, Overwrite, PChar(T.TableName), DBType, PChar(DestTblName))); T.Active := WasOpen; end; // procedure QuickCopyTable(). function AccountFormat( const S: string ): string; var SubString : String; nSubString : integer; begin SubString := S; nSubString := Length(SubString); if (nSubString<12) then begin if (Pos(Copy(SubString,1,2),'_03_02_07_08_')>0) then begin // Business (standard) phone. SubString := Trim(Copy(SubString,1,2)+'-'+Copy(SubString,3,nSubString-2)); end else if Copy(SubString,1,2)='04' then begin // Digital mobile phone. SubString := Copy(SubString,1,4)+'-'+Copy(SubString,5,nSubString-4); end else if (Pos(Copy(SubString,1,4),'_1300_1800_2DIR_1902_')>0) then begin // Customer service calls, etc. SubString := Copy(SubString,1,4)+'-'+Copy(SubString,5,nSubString-4); end else if (Copy(SubString,1,3)='130') then begin SubString := Copy(SubString,1,3)+'-'+Copy(SubString,4,nSubString-3); end else if (Copy(SubString,1,2)='01') then begin // Analogue mobile phone. SubString := Copy(SubString,1,3)+'-'+Copy(SubString,4,nSubString-3); end else if (Length(SubString) = 8) and (Pos(Copy(SubString,5,1),'0123456789') > 0) then begin // Not an SACC account number, assume '03' prefix is missing. SubString := '03-' + SubString; end else if (Length(SubString) = 9) and (Pos(Copy(SubString,1,1),'2378') > 0) then begin // Not an SACC account number, assume '0x' prefix is missing. SubString := '0' + Copy(SubString,1,1)+ '-' +Copy(SubString,2,nSubString-1); end; end; // if (nSubString<12) then begin. Result := SubString; end; // function AccountFormat(). function TestForTestDB: boolean; var NewPPIniFile : TIniFile; IniFileName : string; sDSN : string; sDSNtest : string; begin IniFileName := INIFILEDIRECTORY+ChangeFileExt(ExtractFileName(ParamStr(0)),'.ini'); NewPPIniFile := TIniFile.Create(IniFileName); // dbPPdata - SQLPP (most common) database. with NewPPIniFile do begin sDSN := ReadString('DBconnection','PPDSN', ''); sDSNtest := DM.DecodeString(ReadString('TestCfg','id1', '')); end; NewPPIniFile.Free; // True in the following = Startup call only. Result := (sDSN = sDSNtest) or (Pos('TEST', UpperCase(sDSN)) > 0); end; // TestForTestDB. procedure UpdateBatchTotals(const BatchID: integer); var qry : TQuery; sBatchID : string; curTotalIncGST : currency; curGST : currency; begin sBatchID := IntToStr(BatchID); qry := TQuery.Create(nil); with qry do begin DatabaseName := 'dbPPdata'; SQL.Add('SELECT Sum(CASE DC.AmountIncGST WHEN NULL '+ 'THEN 0 ELSE DC.AmountIncGST END) AS "TotalIncGST",'); SQL.Add(' Sum(CASE DC.GSTAmount WHEN NULL '+ 'THEN 0 ELSE DC.GSTAmount END) AS "GST"'); SQL.Add('FROM tDataCollection AS DC'); SQL.Add('WHERE (DC.RevenueFlag IS NULL OR DC.RevenueFlag = 0)'); SQL.Add('AND DC.BatchID = '+sBatchID); Open; if Bof and Eof then begin curTotalIncGST := 0; curGST := 0; end else begin curTotalIncGST := FieldByName('TotalIncGST').AsCurrency; curGST := FieldByName('GST').AsCurrency; end; Close; SQL.Clear; SQL.Add('UPDATE tBatch'); SQL.Add('SET TotalPayable = '+CurrToStr(curTotalIncGST)+','); SQL.Add(' GSTAmount = '+CurrToStr(curGST)+','); SQL.Add(' TotalAdjustments = NULL'); SQL.Add('WHERE tBatch.ID = '+sBatchID); MainForm.TotalIncGST := curTotalIncGST; MainForm.TotalGST := curGST; ExecSQL; SQL.Clear; end; // qry. qry.Free; end; // UpdateBatchTotals. function ConvertTimeToSecs(const InputTime: string): string; // This is typically used to convert call durations to total seconds - the // separator can be ':' or '.' or both. var sInputTime : string; nTotalTime : integer; nAt : integer; begin sInputTime := InputTime; nTotalTime := 0; nAt := Pos(':', sInputTime); // Test for separator=':' while (nAt > 0) do begin nTotalTime := (nTotalTime + StrToInt(Copy(sInputTime, 1, nAt-1))) * 60; sInputTime := Copy(sInputTime, nAt+1, Length(sInputTime)); nAt := Pos(':', sInputTime); end; nAt := Pos('.', sInputTime); // Test for separator='.' // while (nAt > 0) do begin if (nAt > 0) then begin // nTotalTime := (nTotalTime + StrToInt(Copy(sInputTime, 1, nAt-1))) * 60; nTotalTime := Round((nTotalTime + StrToFloat(sInputTime)) * 60); // sInputTime := Copy(sInputTime, nAt+1, Length(sInputTime)); // nAt := Pos('.', sInputTime); end; nTotalTime := nTotalTime + StrToInt(sInputTime); Result := IntToStr(nTotalTime); end; // ConvertTimeToSecs. procedure AddMissingServiceID(const BatchID, TransactionTypeID: integer); // Note: Added transactions shall be Revenue transactions in tDataCollection. var qry : TQuery; sBatchID : string; sFromDate : string; sToDate : string; sTransactionTypeID : string; sServiceTypeID : string; begin sBatchID := IntToStr(BatchID); sTransactionTypeID := IntToStr(TransactionTypeID); qry := TQuery.Create(nil); with qry do begin DatabaseName := 'dbPPdata'; // Determine the ServiceTypeID to be added. SQL.Clear; SQL.Add('SELECT DISTINCT tServiceID.ServiceTypeID'); SQL.Add('FROM tDataCollection'); SQL.Add('LEFT JOIN tServiceID '+ 'ON tDataCollection.ServiceID = tServiceID.ServiceID'); SQL.Add('WHERE tDataCollection.BatchID = '+ sBatchID); SQL.Add('AND tServiceID.ServiceTypeID IS NOT NULL'); Open; sServiceTypeID := FieldByName('ServiceTypeID').AsString; Close; // Determine the dates to be saved. SQL.Clear; SQL.Add('SELECT tBatch.RentStartDate, tBatch.RentEndDate'); SQL.Add('FROM tBatch'); SQL.Add('WHERE tBatch.ID = '+ sBatchID); Open; if VarIsNull(FieldByName('RentStartDate').AsVariant) then begin sFromDate := 'NULL'; end else begin sFromDate := ''''+FormattedDateString(FieldByName('RentStartDate').AsDateTime)+''''; end; if VarIsNull(FieldByName('RentEndDate').AsVariant) then begin sToDate := 'NULL'; end else begin sToDate := ''''+FormattedDateString(FieldByName('RentEndDate').AsDateTime)+''''; end; Close; SQL.Clear; // Now insert all missing ServiceID entries into the invoice. SQL.Add('INSERT INTO tDataCollection'); SQL.Add('(ServiceID, BatchID, FromDate, ToDate, TransactionTypeID, '+ 'RevenueFlag, AmountExGST, GSTAmount, AmountIncGST, GSTFlag)'); SQL.Add('SELECT SID.ServiceID, SID.BatchID, SID.FromDate, SID.ToDate, '+ 'SID.TransactionTypeID, SID.RevenueFlag, SID.AmountExGST,'); SQL.Add(' SID.GSTAmount, SID.AmountIncGST, SID.GSTFlag'); SQL.Add('FROM (SELECT tServiceID.ServiceID AS "ServiceID",'); SQL.Add('('+sBatchID+') AS "BatchID",'); SQL.Add('('+sFromDate+') AS "FromDate",'); SQL.Add('('+sFromDate+') AS "ToDate",'); SQL.Add('('+sTransactionTypeID+') AS "TransactionTypeID",'); SQL.Add('(1) AS "RevenueFlag",'); SQL.Add('(0) AS "AmountExGST",'); SQL.Add('(0) AS "GSTAmount",'); SQL.Add('(0) AS "AmountIncGST",'); SQL.Add('(''Y'') AS "GSTFlag"'); SQL.Add('FROM tServiceID'); SQL.Add('WHERE tServiceID.ServiceTypeID = '+sServiceTypeID); SQL.Add('AND tServiceID.Active = 1) AS SID'); SQL.Add('LEFT JOIN'); SQL.Add('(SELECT DISTINCT tDataCollection.ServiceID'); SQL.Add('FROM tDataCollection'); SQL.Add('WHERE tDataCollection.BatchID = '+sBatchID+') AS DCD'); SQL.Add('ON SID.ServiceID = DCD.ServiceID'); SQL.Add('WHERE DCD.ServiceID IS NULL'); ExecSQL; SQL.Clear; end; // qry. qry.Free; end; // AddMissingServiceID. { function UpdateFaultsTable(const nBatchID: integer;const sPeriod: string): boolean; var qFQuetzal : TQuery; dsFQuetzal: TDataSource; qFault : TQuery; sBatchID : string; sBillingPeriod: string; // nAt : integer; begin sBatchID := IntToStr(nBatchID); sBillingPeriod := sPeriod; // nAt := Pos('/', sBillingPeriod); // if (nAt > 0) then // sBillingPeriod := Copy(sBillingPeriod,1,nAt-1) + // Copy(sBillingPeriod, nAt+1, Length(sBillingPeriod)); qFQuetzal := TQuery.Create(MainForm); // Remove any data that conflicts with the new information. with qFQuetzal do begin DatabaseName := 'dbPPdata'; SQL.Add('DELETE FROM tFaultDetails'); SQL.Add('WHERE BatchID = '+sBatchID); SQL.Add('AND BillingPeriod LIKE '''+sBillingPeriod+''''); ExecSQL; SQL.Clear; // Setup the query with all of the data to be copied to PreProcessor. DatabaseName := 'dbQuetzal'; SQL.Add('Select c.CallNumber, c.LastName, c.FirstName,'); SQL.Add(' c.Ref2, c.CallSubject1, c.CallSubject2, c.CallSubject3,'); SQL.Add(' c.Logon, c.ConfigId, c.ConfigCallPrompt, c.SupportGroup,'); SQL.Add(' c.ResolutionCode1, c.ResolutionCode2, c.ResolutionCode3,'); SQL.Add(' c.LogDatTim, c.AllDatTim, c.LastDatTim, c.SLT1,'); SQL.Add(' s.SLTUnique, c.LogonCode,'); SQL.Add('DATEDIFF(mi, c.AllDatTim, c.LastDatTim) AS "ReportedDowntime", '+ 'comm.Comments AS "DowntimeComments",'); SQL.Add(' c.OrgLvlCode as "ShipTo",'); SQL.Add(' ce.EventCode, ce.IthelpUser, ce.EventDateTime,'); SQL.Add(' ce.IsCurrentEvent, c.comments,'); SQL.Add(' s.TarFixWks, s.TarFixHrs, s.TarFixMins, s.TarResWks, s.TarResHrs,'); SQL.Add(' s.TarResMins, custe.EventName, cf.Ref3 AS "ServiceID",'); SQL.Add(' DATEDIFF(mi, c.AllDatTim, c.LastDatTim) AS "QuetzalDownTime",'); SQL.Add(' (CASE WHEN c.SLTUnique1 = 153 OR c.SLTUnique1 = 157 THEN ''Station'''); SQL.Add(' WHEN c.SLTUnique1 = 154 OR c.SLTUnique1 = 155 OR '+ 'c.SLTUnique1 = 156 THEN ''Network'''); SQL.Add(' ELSE ''Unknown'' END) AS "AvailabilityType",'); SQL.Add(' ('+sBatchID+') AS "BatchID", '+ '('''+sBillingPeriod+''') AS "BillingPeriod"'); SQL.Add('FROM Call c'); SQL.Add(' INNER JOIN Call_Event ce ON c.CallNumber = ce.CallNumber'); SQL.Add(' INNER JOIN Custom_Event custe ON ce.EventCode = custe.EventCode'); SQL.Add(' INNER JOIN Configuration cf ON c.ConfigId = cf.ConfigId'); SQL.Add(' INNER JOIN SLT s ON c.SLTUnique1 = s.SLTUnique'); SQL.Add(' LEFT OUTER JOIN Call_Comments comm ON c.CallNumber = comm.CallNumber'); SQL.Add(' WHERE (cf.ConfigClassificationUnique = 11'); SQL.Add(' OR c.CallSubject2 LIKE ''KAMCO'')'); SQL.Add(' AND (CAST(DATEPART(yyyy,c.LogDatTim) AS varchar) + ''/'' + '+ ' RIGHT(''0'' + CAST(DATEPART(mm,c.LogDatTim) AS varchar),2)) LIKE '''+ sBillingPeriod+''''); SQL.Add(' AND ce.EventCode > 100'); SQL.Add(' AND ce.IsCurrentEvent = 1'); Open; end; if qFQuetzal.Eof then begin MessageDlg('No entries found in Quetzal for faults.', mtInformation, [mbOk], 0); Result := False; end else begin dsFQuetzal := TDataSource.Create(MainForm); dsFQuetzal.DataSet := qFQuetzal; qFault := TQuery.Create(MainForm); // Establish the Insert statement with the data to be saved - // this is done like a master-slave relationship. with qFault do begin DatabaseName := 'dbPPdata'; SQL.Add('Insert into tFaultDetails'); SQL.Add('(CallNumber, LastName, FirstName,'); SQL.Add(' Ref2, CallSubject1, CallSubject2, CallSubject3,'); SQL.Add(' Logon, ConfigId, ConfigCallPrompt, SupportGroup,'); SQL.Add(' ResolutionCode1, ResolutionCode2, ResolutionCode3,'); SQL.Add(' LogDatTim, AllDatTim, LastDatTim, SLT1,'); SQL.Add(' SLTUnique, LogonCode,'); SQL.Add(' ReportedDowntime, DowntimeComments,'); SQL.Add(' ShipTo,'); SQL.Add(' EventCode, IthelpUser, EventDateTime,'); SQL.Add(' IsCurrentEvent, comments, TarFixWks, TarFixHrs,'); SQL.Add(' TarFixMins, TarResWks, TarResHrs,'); SQL.Add(' TarResMins, EventName, ServiceID,'); SQL.Add(' QuetzalDownTime,)'); SQL.Add(' AvailabilityType,)'); SQL.Add(' BatchID, BillingPeriod)'); SQL.Add('VALUES (:CallNumber, :LastName, :FirstName,'); SQL.Add(' :Ref2, :CallSubject1, :CallSubject2, :CallSubject3,'); SQL.Add(' :Logon, :ConfigId, :ConfigCallPrompt, :SupportGroup,'); SQL.Add(' :ResolutionCode1, :ResolutionCode2, :ResolutionCode3,'); SQL.Add(' :LogDatTim, :AllDatTim, :LastDatTim, :SLT1,'); SQL.Add(' :SLTUnique, :LogonCode,'); SQL.Add(' :ReportedDowntime, :DowntimeComments,'); SQL.Add(' :ShipTo,'); SQL.Add(' :EventCode, :IthelpUser, :EventDateTime,'); SQL.Add(' :IsCurrentEvent, :Comments, :TarFixWks, :TarFixHrs,'); SQL.Add(' :TarFixMins, :TarResWks, :TarResHrs,'); SQL.Add(' :TarResMins, :EventName, :ServiceID,'); SQL.Add(' :QuetzalDownTime,'); SQL.Add(' :AvailabilityType,'); SQL.Add(' :BatchID, :BillingPeriod)'); DataSource := dsFQuetzal; Prepare; end; // qFault. // Now read each record of data and save it to the PreProcessor. while not qFQuetzal.Eof do begin qFault.ExecSQL; qFQuetzal.Next; end; // Finished - clean up. qFault.Close; qFault.Free; dsFQuetzal.Free; Result := True; end; // Finished - clean up. qFQuetzal.Close; qFQuetzal.Free; end; // UpdateFaultsTable. } procedure SetParameter(const sParm, sParmValue, sParmField: string); var qParam : TQuery; sValue : string; begin qParam := TQuery.Create(MainForm); with qParam do begin DatabaseName := 'dbPPdata'; SQL.Add('SELECT ParmField'); SQL.Add('FROM tParameter'); SQL.Add('WHERE Parm LIKE '''+sParm+''''); Open; sValue := UpperCase(FieldByName('Parmfield').AsString); Close; SQL.Clear; if (Length(sValue) = 0) then begin SQL.Add('INSERT INTO tParameter'); SQL.Add('(Parm, ParmField, '+sParmField+', ParmUserDefined)'); if (sParmField = 'PARMTEXT') or (sParmField = 'PARMDATE') then begin SQL.Add('VALUES ('''+sParm+''', '''+sParmField+''', '''+sParmValue+''',1)'); end else begin SQL.Add('VALUES ('''+sParm+''', '''+sParmField+''', '+sParmValue+',1)'); end; end else begin SQL.Add('UPDATE tParameter'); if (sParmField = 'PARMTEXT') or (sParmField = 'PARMDATE') then begin SQL.Add('SET '+sParmField+' = '''+sParmValue+''''); end else begin SQL.Add('SET '+sParmField+' = '+sParmValue); end; SQL.Add('WHERE Parm LIKE '''+sParm+''''); end; ExecSQL; end; end; // SetParameter. procedure GetParameter(const sParm:string; var sParmValue: string); var qParam : TQuery; sValue : string; begin qParam := TQuery.Create(MainForm); with qParam do begin DatabaseName := 'dbPPdata'; SQL.Add('SELECT ParmField'); SQL.Add('FROM tParameter'); SQL.Add('WHERE Parm LIKE '''+sParm+''''); Open; sValue := FieldByName('Parmfield').AsString; Close; if (Length(sValue) = 0) then begin sParmValue := sValue; end else begin SQL[0] := 'SELECT '+sValue; Open; sParmValue := FieldByName(sValue).AsString; Close; end; end; end; // GetParameter. // ***************************************************************** // SAVE THE QUERY DATA PASSED TO A CSV FILE // ***************************************************************** procedure FileQuery(const qryData:TQuery;const FileName: string ); // This procedure creates a CSV file from the query parameter and saves it // in the directory selected below and the filename chosen below. var SaveDialog : TSaveDialog; lContinue : Boolean; CSVTextFile : TextFile; Progress : TProgressForm; nFactor : Real; sFile : String; sline : Integer; nFieldNumber : integer; sOriginalDirectory : string; sUserDirectory : string; sCSVString : string; FieldList : TStringList; begin FieldList := TStringList.Create; // The table required for printing must already be open. // Determine the parameters for the progress bar. sline := qryData.RecordCount; if sLine = 0 then begin MessageDlg('No entries found in table '+ FileName, mtInformation,[mbOk],0); end else begin nFactor := 100.0 / sline; // Data passed twice:Verify,CostPart. // Reset the record counter. sline := 0; GetParameter('UserDirectory',sUserDirectory); lContinue := (Length(sUserDirectory)>0) and DirectoryExists(sUserDirectory); if lContinue then sOriginalDirectory := sUserDirectory; // Confirm with the operator where the file is to be saved. SaveDialog := TSaveDialog.Create(Nil); SaveDialog.Title := 'Save the selected table values in CSV format'; SaveDialog.FileName := FileName; SaveDialog.Filter := 'All Files (*.*)|*.*'; SaveDialog.FilterIndex := 1; SaveDialog.DefaultExt := 'csv'; if lContinue then begin // Use the default directory obtained from tParameters. SaveDialog.InitialDir := sUserDirectory; end else begin // Use the program directory as the default directory. SaveDialog.InitialDir := ExtractFilePath(ParamStr(0)); end; SaveDialog.Options := [ofHideReadOnly,ofNoReadOnlyReturn]; lContinue := SaveDialog.Execute; sFile := SaveDialog.FileName; SaveDialog.Free; sUserDirectory := ExtractFileDir(sFile); if lContinue and DirectoryExists(sUserDirectory) and (sUserDirectory <> sOriginalDirectory) then begin // Save the directory name in tParameter. SetParameter('UserDirectory',sUserDirectory,'PARMTEXT'); end; // DirectoryExists. if lContinue then begin // Open the progress form. Progress := TProgressForm.Create(NIL); // Disable the Abort button - Printer not active. Progress.btnCancel.Enabled := False; Progress.btnCancel.Visible := False; // Display a message to the user. Progress.Msg.Caption := 'Saving account data to file ...'; Progress.Show; // Create the required file. AssignFile( CSVTextFile, sFile ); try Rewrite( CSVTextFile ); // OK, now output the data to the file. // Print the field names first. sCSVString := ''; qryData.GetFieldNames(FieldList); for nFieldNumber := 0 to FieldList.Count -1 do begin sCSVString := sCSVString + '"' + FieldList.Strings[nFieldNumber]+'"'; if (nFieldNumber < (FieldList.Count -1)) then begin sCSVString := sCSVString + ','; end; end; // Output the information to the file. Writeln( CSVTextFile, sCSVString ); // Start at the beginning. qryData.First; while (not qryData.Eof) do begin Progress.ProcessWinMessages(MainForm); // Do not lockup the computer. // Develop the line of information. sCSVString := ''; for nFieldNumber := 0 to qryData.FieldCount -1 do begin sCSVString := sCSVString +'"' + qryData.Fields[nFieldNumber].AsString +'"'; if (nFieldNumber < (qryData.FieldCount -1)) then begin sCSVString := sCSVString + ','; end; end; // Output the information to the file. Writeln( CSVTextFile, sCSVString ); // Report progress to the user. Inc(sLine); Progress.ProgressBar1.Position := Trunc(sline * nFactor); // Go to the next line in the result set. qryData.Next; end; // while (not qryData.Eof) and. finally // Done, now close the output file. CloseFile( CSVTextFile ); Progress.Close; end; // try. end; // if sLine > 0 (some data to write). end; // if lContinue then. end; // procedure FileQuery(). procedure Record_DataTaken(const nBatchID: integer); var qry : TQuery; qryQuote : TQuery; sBillPeriod : string; // Format change not required - yyyy/mm same in quote & tbsdata. RJC 171017. sPartBillPeriod : string; sCallNumber : string; sBatchID : string; // sServiceTypeID : string; nProgramID : integer; sProgramID : string; begin sBatchID := IntToStr(nBatchID); qry := TQuery.Create(MainForm); qry.DatabaseName := 'dbPPdata'; with qry do begin // Update the tFaultDetails table (if processed) now. SQL.Add('SELECT COUNT(*) AS nTotal'); SQL.Add('FROM tFaultDetails'); SQL.Add('WHERE BatchID = '+sBatchID); Open; end; // with qry. if (qry.FieldByName('nTotal').AsInteger > 0) then begin // tFaultDetails is used, so update that table and tTransaction entries. // NB tTransaction.ServiceID has been Normalised (is an integer). with qry do begin Close; SQL.Clear; // Save Availability into the Var02 field. SQL.Add('UPDATE tTransaction'); SQL.Add('SET Var02 = FDetails.Var02'); SQL.Add('FROM (SELECT LTRIM(CAST(tFaultDetails.Availability AS varchar(12)))'+ ' AS Var02, tServiceID.ID AS ServiceID_ID'); SQL.Add(' FROM tFaultDetails'); SQL.Add(' LEFT JOIN tServiceID ON tFaultDetails.ServiceID LIKE '+ ' tServiceID.ServiceID'); SQL.Add(' WHERE tFaultDetails.BatchID = '+sBatchID); SQL.Add(' AND LTRIM(RTRIM(tFaultDetails.ServiceID)) NOT LIKE '''') '+ ' AS FDetails'); SQL.Add('WHERE tTransaction.BatchID = '+sBatchID); SQL.Add('AND tTransaction.ServiceID = FDetails.ServiceID_ID'); ExecSQL; SQL.Clear; SQL.Add('UPDATE tFaultDetails'); SQL.Add('SET PPTaken = 1'); SQL.Add('WHERE BatchID = '+sBatchID); ExecSQL; end; // with qry. end; // eof. // Prepare to update the VRTquote table. with qry do begin SQL.Clear; SQL.Add('SELECT tBatch.BillingPeriod, tBatchType.ProgramID'); SQL.Add('FROM tBatch'); SQL.Add('INNER JOIN tBatchType ON tBatch.BatchTypeID = tBatchType.ID'); SQL.Add('WHERE tBatch.ID = '+sBatchID); // Next line ensures only the correct types are processed. SQL.Add('AND tBatchType.ProgramID IN ('+ IntToStr(PAUTOMATIC_MARVAL_QUOTE_INSTALL_ANYTIME)+ ', '+IntToStr(PAUTOMATIC_MARVAL_QUOTE_PURCHASE_ANYTIME)+ ', '+IntToStr(PAUTOMATIC_QUOTE_INSTALL)+ ', '+IntToStr(PAUTOMATIC_QUOTE_PURCHASE)+ ', '+IntToStr(PAUTOMATIC_QUOTE_INSTALL_ANYTIME)+ ', '+IntToStr(PAUTOMATIC_QUOTE_PURCHASE_ANYTIME)+ ')'); { SQL.Add('AND ((tBatchType.Description LIKE ''VicTrack Purch%'')'); SQL.Add(' OR (tBatchType.Description LIKE ''VicTrack Instal%''))'); } Open; end; // with qry. if qry.Eof then begin sBillPeriod := ''; nProgramID := 0; sProgramID := '0'; end else begin sBillPeriod := qry.FieldByName('BillingPeriod').AsString; nProgramID := qry.FieldByName('ProgramID').AsInteger; sProgramID := IntToStr(nProgramID); end; // Eof. qry.Close; if (Length(sBillPeriod) = 7) and (nProgramID > 0) then begin // Update the VRTquote table if processed now. // Format change not required - yyyy/mm same in quote & tbsdata. RJC 171017. sPartBillPeriod := Copy(sBillPeriod,6,2) + Copy(sBillPeriod,1,4); sBillPeriod := sPartBillPeriod; with qry do begin // Get the CallNumber field values. SQL.Clear; SQL.Add('SELECT tDataCollection.Var01, tServiceID.ServiceTypeID'); SQL.Add('FROM tDataCollection'); SQL.Add('LEFT JOIN tServiceID ON tDataCollection.ServiceID LIKE '+ 'tServiceID.ServiceID'); SQL.Add('LEFT JOIN tBatch on tDataCollection.BatchID = tBatch.ID'); SQL.Add('LEFT JOIN tBatchType ON tBatch.BatchTypeID = tBatchType.ID'); SQL.Add('WHERE tDataCollection.BatchID = '+sBatchID); // 170913 RJC: Better filter condition than Description field content, so: SQL.Add('AND tBatchType.ProgramID = '+sProgramID); { // 170913 RJC: Replaced the following filter. SQL.Add('AND ((tBatchType.Description LIKE ''%Purchas%'')'); SQL.Add(' OR (tBatchType.Description LIKE ''%Instal%''))'); } SQL.Add('AND tDataCollection.Var01 IS NOT NULL'); Open; end; // qry. qryQuote := TQuery.Create(MainForm); if ((nProgramID = PAUTOMATIC_MARVAL_QUOTE_INSTALL_ANYTIME) or (nProgramID = PAUTOMATIC_MARVAL_QUOTE_PURCHASE_ANYTIME)) then begin // Use the Marval database. qryQuote.DatabaseName := 'dbMQuote'; end else begin // Use the Quetzal database. qryQuote.DatabaseName := 'dbQuote'; end; with qryQuote do begin SQL.Add('UPDATE Quote_Items'); SQL.Add('SET Quote_Items.PPTaken = 1'); SQL.Add('WHERE Quote_Items.BillPeriod LIKE '''+sBillPeriod+''''); // SQL.Add('AND Quote_Items.BatchTypeID = '+sBatchTypeID); SQL.Add('AND'); // A dummy line to be replaced in the following loop. SQL.Add('AND'); // A dummy line to be replaced in the following loop. end; // qryQuote. while not qry.Eof do begin // This is actually where VRTquote is updated for each CallNumber. sCallNumber := qry.FieldByName('Var01').AsString; // sServiceTypeID := qry.FieldByName('ServiceTypeID').AsString; if (Length(sCallNumber) > 0) then begin qryQuote.SQL.Strings[3] := 'AND Quote_Items.CallNumber LIKE '''+sCallNumber+''''; qryQuote.SQL.Strings[4] := 'AND Quote_Items.ServiceTypeID = '+ qry.FieldByName('ServiceTypeID').AsString; qryQuote.ExecSQL; end; qry.Next; end; // qry.eof. qryQuote.Free; end; // sBillPeriod valid, nProgram > 0. qry.Free; end; // Record_DataTaken. function ReplacePartString(const sInputString, sOldStr, sNewStr : string): string; var FullString: string; // TempString : string; OldStr : string; NewStr : string; // iPos : integer; begin FullString := sInputString; OldStr := sOldStr; NewStr := sNewStr; // iPos := Pos(FullString, OldStr); // Replace the old value with the new value. // while iPos > 0 do // begin // Swap over the strings using the temporary string variable. Result := StringReplace( FullString, OldStr, NewStr, [rfReplaceAll]); // TempString := Copy(FullString, 1, iPos-1) + NewStr + // Copy(FullString, iPos+1, Length(FullString)); // // Update the FullString value and retest for iPos. // FullString := TempString; // iPos := Pos(FullString, sOldStr) // end; // while iPos // Result := FullString; end; // ReplacePartString. end.