{*********************************************************} {* FlashFiler: Client utility routines *} {*********************************************************} (* ***** BEGIN LICENSE BLOCK ***** * Version: MPL 1.1 * * The contents of this file are subject to the Mozilla Public License Version * 1.1 (the "License"); you may not use this file except in compliance with * the License. You may obtain a copy of the License at * http://www.mozilla.org/MPL/ * * Software distributed under the License is distributed on an "AS IS" basis, * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License * for the specific language governing rights and limitations under the * License. * * The Original Code is TurboPower FlashFiler * * The Initial Developer of the Original Code is * TurboPower Software * * Portions created by the Initial Developer are Copyright (C) 1996-2002 * the Initial Developer. All Rights Reserved. * * Contributor(s): * * ***** END LICENSE BLOCK ***** *) {$I ffdefine.inc} unit ffutil; interface uses DB, ffdb, Windows, Messages, Classes, SysUtils, ffllprot, fflldict, ffllbase, ffstdate; type TffCopyTableProgressEvent = procedure (Index : Integer); procedure KillExternalServer(const aBlocking : Boolean); { - Kill the server process running locally } function FFGetMaxAutoInc(aTable : TffTable) : Longint; { - Retrieve the MaxAutoInc value used in a table. This routine does not get the last one used, instead it queries each record and returns the highest key currently in the table. } function FFGetProtocolString (Protocol : TffProtocolType) : string; { - Converts a TffProtocolType value to a string value } function FFGetProtocolType (ProtocolStr : string) : TffProtocolType; { - Converts the specified string to a valid TffProtocolType } procedure FFRetrieveLiveServers(const Protocol: TffProtocolType; ServerNames : TStringList); { - Fills ServerName with a list of servers for the specified protocol. Care is taken to remove the local server if it cannot be found. } procedure FFSeparateAddress(const Original : string; var Name : string; var Address : string); { - Breaks the specifid address into Name & address parts } function FFTransferRecord(Source, Dest : TDataSet) : Boolean; { - Transfers the current record from Source to Dest, matching fields by name. The result will be true if the routine was successful. } procedure FFCopyTableData(SourceTable, DestTable : TDataset); { - Transfers the records from SourceTable to DestTable. SourceTable's cursor will be First and finish at EOF. Ranges and Filters will not be disturbed by this routine } procedure FFCopyTableDataEx(SourceTable, DestTable : TDataset; ProgressEvent: TffCopyTableProgressEvent); { - Transfers the records from SourceTable to DestTable. SourceTable's cursor will be First and finish at EOF. Ranges and Filters will not be disturbed by this routine. This routine has the ability to call a progress event } procedure FFStringToVCheckVal(const aStr : string; const aType : TffFieldType; var aVal : TffVCheckValue); { Converts a string to a TffVCheckValue. Used to set the default for a field in the data dictionary } function FFVCheckValToString(const aVal : TffVCheckValue; const aType : TffFieldType) : String; { Converts a TffVCheckValue to a string. Used to retrieve a string representation of the default value for a field in a data dictionary } implementation uses FFClCfg, FFCLconv; procedure KillExternalServer(const aBlocking : Boolean); var Handle : THandle; begin Handle := FindWindowEx(0, 0, 'TfrmFFServer', nil); if Handle > 0 then if aBlocking then SendMessage(Handle, WM_Close, 0, 0) else PostMessage(Handle, WM_Close, 0, 0); end; {--------} function FFGetMaxAutoInc(aTable : TffTable) : Longint; var MaxSeed : Longint; AField : TAutoIncField; begin AField := nil; for MaxSeed := 0 to Pred(aTable.FieldCount) do if aTable.Fields[MaxSeed] is TAutoIncField then begin AField := TAutoIncField(aTable.Fields[MaxSeed]); Break; end; if not Assigned(AField) then begin Result := 0; Exit; end; MaxSeed := 0; aTable.First; while not aTable.EOF do begin if AField.Value > MaxSeed then MaxSeed := AField.Value; aTable.Next; end; Result := MaxSeed; end; {--------} function FFGetProtocolString (Protocol : TffProtocolType) : string; begin case Protocol of ptIPXSPX : Result := ffc_IPXSPX; ptTCPIP : Result := ffc_TCPIP; else Result := ffc_SingleUser; end; end; {--------} function FFGetProtocolType (ProtocolStr : string) : TffProtocolType; begin if ProtocolStr = ffc_IPXSPX then Result := ptIPXSPX else if ProtocolStr = ffc_TCPIP then Result := ptTCPIP else Result := ptSingleUser; end; {--------} procedure FFRetrieveLiveServers(const Protocol: TffProtocolType; ServerNames : TStringList); var CE : TffCommsEngine; SE : TffSession; begin CE := TffCommsEngine.Create(nil); try CE.CommsEngineName := 'TEST'; CE.Protocol := Protocol; CE.Open; ServerNames.Clear; if Protocol <> ptSingleUser then begin CE.GetServerNames(ServerNames); end else begin SE := TffSession.Create(nil); SE.SessionName := 'TEST'; try SE.CommsEngineName := 'TEST'; try SE.Open; ServerNames.Add('local'); except end; finally SE.Free; end; end; finally CE.Free; end; end; {--------} procedure FFSeparateAddress(const Original: string; var Name, Address: string); var SepPlace : Integer; ServerName : string; begin ServerName := Original; SepPlace := Pos('@', ServerName); if SepPlace > 0 then begin Name := Copy(ServerName, 1, pred(SepPlace)); Delete(ServerName,1,SepPlace); Address := ServerName; end else begin Name := ServerName; end; end; {--------} function FFTransferRecord(Source, Dest : TDataSet) : Boolean; var i, nErr : integer; f1, f2 : TField; begin nErr := 0; if (dest.state in [dsEdit, dsInsert]) {= dsBrowse} then begin end else begin Dest.Edit; end; for I := 0 to (Dest.FieldCount - 1) do begin f1 := Dest.FindField(Dest.Fields[I].FieldName); f2 := Source.FindField(Dest.Fields[I].FieldName); if (((f1 <> nil) and (f2 <> nil)) and (dest.Fields[I].FieldName <> 'RefNum') and (dest.Fields[I].FieldName <> 'AutoInc')) then begin try f1.value := f2.value; except inc(nErr); end; end else begin end; end; Dest.Post; Result := (nErr < Dest.FieldCount); end; {--------} procedure FFCopyTableData(SourceTable, DestTable : TDataset); begin SourceTable.First; while not SourceTable.EOF do begin DestTable.Insert; FFTransferRecord(SourceTable, DestTable); SourceTable.Next; end; end; procedure FFCopyTableDataEx(SourceTable, DestTable : TDataset; ProgressEvent: TffCopyTableProgressEvent); var Idx : Integer; begin SourceTable.First; Idx := 0; while not SourceTable.EOF do begin DestTable.Insert; FFTransferRecord(SourceTable, DestTable); inc(Idx); if Assigned(ProgressEvent) then ProgressEvent(Idx); SourceTable.Next; end; end; procedure FFStringToVCheckVal(const aStr : string; const aType : TffFieldType; var aVal : TffVCheckValue); var TempStr : String[255]; TempInt : Longint; TempExtend : Extended; TempCurrency: Currency; TempSingle : Single; TempDouble : Double; TempStDate : TStDate; TempStTime : TStTime; TempDT : TDateTime; TempTS : TTimeStamp; TempComp : Comp; TempWideStr : WideString; begin if (aStr <> '') then begin FillChar(aVal, SizeOf(TffVCheckValue), #0); case aType of fftStDate : begin TempStDate := FFStringToStDate(aStr); Move(TempStDate, aVal, sizeof(TStDate)); end; fftStTime : begin TempStTime := FFStringToStTime(aStr); Move(TempStTime, aVal, sizeof(TStTime)); end; fftWord16 : begin TempInt := StrToInt(aStr); MapBDEDataToFF(fftWord16, sizeof(Word), @TempInt, @aVal); end; fftWord32 : begin TempInt := StrToInt(aStr); MapBDEDataToFF(fftWord32, sizeof(TffWord32), @TempInt, @aVal); end; fftInt8 : begin TempInt := StrToInt(aStr); MapBDEDataToFF(fftInt8, sizeof(Shortint), @TempInt, @aVal); end; fftInt16 : begin TempInt := StrToInt(aStr); MapBDEDataToFF(fftInt16, sizeof(Smallint), @TempInt, @aVal); end; fftInt32 : begin TempInt := StrToInt(aStr); MapBDEDataToFF(fftInt32, sizeof(Longint), @TempInt, @aVal); end; fftChar : begin TempStr := aStr; MapBDEDataToFF(fftChar, sizeof(Char), @TempStr[1], @aVal); end; fftWideChar : begin StringToWideChar(aStr, @TempStr, sizeof(WideChar)); MapBDEDataToFF(fftWideChar, sizeof(WideChar), @TempStr, @aVal); end; fftByte : begin TempInt := StrToInt(aStr); MapBDEDataToFF(fftByte, sizeof(Byte), @TempInt, @aVal); end; fftSingle : begin TempSingle := StrToFloat(aStr); Move(TempSingle, aVal, sizeof(Single)); end; fftDouble : begin TempDouble := StrToFloat(aStr); MapBDEDataToFF(fftDouble, sizeof(Double), @TempDouble, @aVal); end; fftExtended : begin TempExtend := StrToFloat(aStr); Move(TempExtend, aVal, sizeof(Extended)); end; fftComp : begin TempComp := StrToFloat(aStr); Move(TempComp, aVal, sizeof(Comp)); end; fftCurrency : begin TempCurrency := StrToFloat(aStr); Move(TempCurrency, aVal, sizeof(Currency)); end; fftDateTime : begin TempDT := StrToDateTime(aStr); TempTS := DateTimeToTimeStamp(TempDT); TempDT := TimeStampToMSecs(TempTS); MapBDEDataToFF(fftDateTime, sizeof(TDateTime), @TempDT, @aVal); end; fftBoolean : begin if ((UpperCase(aStr) = 'TRUE') or (UpperCase(aStr) = 'T')) then TempInt := 1 else if ((UpperCase(aStr) = 'FALSE') or (UpperCase(aStr) = 'F')) then TempInt := 0; MapBDEDataToFF(fftBoolean, sizeof(Boolean), @TempInt, @aVal); end; fftByteArray : begin TempStr := aStr; MapBDEDataToFF(fftByteArray, sizeof(ffcl_MaxVCheckLength), @TempStr, @aVal); end; fftShortAnsiStr : begin TempStr := aStr; Move(TempStr, aVal, Succ(Length(aStr))); end; fftShortString : begin TempStr := aStr; Move(TempStr, aVal, Succ(Length(aStr))); end; fftNullString : begin TempStr := aStr; MapBDEDataToFF(fftNullString, succ(Length(TempStr)), @TempStr[1], @aVal); end; fftNullAnsiStr : begin TempStr := aStr; MapBDEDataToFF(fftNullString, succ(Length(TempStr)), @TempStr[1], @aVal); end; fftWideString : begin StringToWideChar(aStr, @TempWideStr, (Length(aStr) * 2)); Move(TempWideStr, aVal, (Length(aStr) * 2)); end; end; end; end; function FFVCheckValToString(const aVal : TffVCheckValue; const aType : TffFieldType) : string; var TempStr : string[255]; // TempInt8 : ShortInt; {!!.07} TempInt16 : SmallInt; TempInt64 : TffInt64; {!!.13} TempInt : Longint; TempExtend : Extended; TempCurrency: Currency; TempSingle : Single; TempDouble : Double; TempStDate : TStDate; TempStTime : TStTime; TempDT : TDateTime; TempTS : TTimeStamp; TempComp : Comp; TempWideStr : WideString; i : Integer; begin case aType of fftWord16 : begin MapFFDataToBDE(fftWord16, sizeof(Word), @aVal, @TempInt); TempStr := IntToStr(TempInt); end; fftWord32 : begin MapFFDataToBDE(fftWord32, sizeof(TffWord32), @aVal, @TempInt); TempStr := IntToStr(TempInt); end; fftInt8 : begin {NOTE: Int8 mapped to 16-bit integer because the VCL does not have a 8-bit integer field type. } MapFFDataToBDE(fftInt8, SizeOf(ShortInt), @aVal, @TempInt16); {!!.07} TempStr := IntToStr(TempInt16); {!!.07} end; fftInt16 : begin MapFFDataToBDE(fftInt16, sizeof(Smallint), @aVal, @TempInt16); TempStr := IntToStr(TempInt16); end; fftInt32 : begin MapFFDataToBDE(fftInt32, sizeof(Longint), @aVal, @TempInt); TempStr := IntToStr(TempInt); end; fftStDate : begin Move(aVal, TempStDate, sizeof(TStDate)); TempStr := FFStDateToString(TempStDate); end; fftStTime : begin Move(aVal, TempStTime, sizeof(TStTime)); TempStr := FFStTimeToString(TempStTime); end; fftChar : begin TempInt := 1; Move(TempInt, TempStr[0], 1); MapFFDataToBDE(fftChar, sizeof(Char), @aVal, @TempStr[1]); end; fftWideChar : begin MapFFDataToBDE(fftWideChar, sizeof(Widechar), @aVal, @TempStr); TempStr := WideCharToString(@TempStr);; end; fftByte : begin MapFFDataToBDE(fftByte, sizeof(Byte), @aVal, @TempInt); TempStr := IntToStr(TempInt); end; fftSingle : begin Move(aVal, TempSingle, sizeof(Single)); TempStr := FloatToStr(TempSingle); end; fftDouble : begin MapFFDataToBDE(fftDouble, sizeof(Double), @aVal, @TempDouble); TempStr := FloatToStr(TempDouble); end; fftExtended : begin Move(aVal, TempExtend, sizeof(Extended)); TempStr := FloatToStr(TempExtend); end; fftCurrency : begin Move(aVal, TempCurrency, sizeof(Currency)); TempStr := FloatToStr(TempCurrency); end; fftComp : begin Move(aVal, TempComp, sizeof(Comp)); TempStr := FloatToStr(TempComp); end; fftDateTime : begin MapFFDataToBDE(fftDateTime, sizeof(TDateTime), @aVal, @TempDT); TempTS := MSecsToTimeStamp(TempDT); TempDT := TimeStampToDateTime(TempTS); TempStr := DateTimeToStr(TempDT); end; fftBoolean : begin MapFFDataToBDE(fftBoolean, sizeof(Boolean), @aVal, @TempInt); // if (TempInt = 0) then {!!.12} if Byte(TempInt) = 0 then {!!.12} TempStr := 'False' else TempStr := 'True'; end; fftByteArray : begin MapFFDataToBDE(fftByteArray, ffcl_MaxVCheckLength, @aVal, @TempStr); end; fftShortAnsiStr : begin MapFFDataToBDE(fftShortAnsiStr, ffcl_MaxVCheckLength, @aVal, @TempStr); MapFFDataToBDE(fftShortString, ffcl_MaxVCheckLength, @aVal, @TempStr[1]); i := 0; while TempStr[succ(i)] <> #0 do inc(i); SetLength(TempStr, i); end; fftShortString : begin MapFFDataToBDE(fftShortString, ffcl_MaxVCheckLength, @aVal, @TempStr[1]); i := 0; while TempStr[succ(i)] <> #0 do inc(i); SetLength(TempStr, i); end; fftNullString : begin MapFFDataToBDE(fftNullString, pred(ffcl_MaxVCheckLength), @aVal, @TempStr[1]); i := 0; while TempStr[succ(i)] <> #0 do inc(i); SetLength(TempStr, i); end; fftNullAnsiStr : begin MapFFDataToBDE(fftNullString, pred(ffcl_MaxVCheckLength), @aVal, @TempStr[1]); i := 0; while TempStr[succ(i)] <> #0 do inc(i); SetLength(TempStr, i); end; fftWideString : begin i := 0; while ((char(aVal[i])) + (char(aVal[succ(i)]))) <> #0#0 do inc(i); Move(aVal, TempWideStr, succ(i)); TempStr := WideCharToString(@TempWideStr); end; {Begin !!.13} fftBLOB..fftBLOBTypedBin : begin Move(aVal, TempInt64, SizeOf(TempInt64)); TempStr := IntToStr(TempInt64.iHigh) + ':' + IntToStr(TempInt64.iLow); end; {End !!.13} else begin TempStr := ''; end; end; Result := TempStr; end; end.