home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 February / Chip_2003-02_cd1.bin / zkuste / delphi / kompon / d34567 / KADAO77.ZIP / DaoUtils.pas < prev    next >
Pascal/Delphi Source File  |  2002-03-11  |  9KB  |  271 lines
  1. unit DaoUtils;
  2. //******************************************************************************
  3. //                    Delphi Dao Project Version 2.40
  4. //                 Copyright (c) 2000 by Kiril Antonov
  5. //******************************************************************************
  6. // 05.07 2000 - Fixed a very rediculous bug in RemoveNonDigitChars
  7. //              Now it works properly. RemoveNonDigitChars_II removed!
  8. {$I KADaoCommonDirectives.pas}
  9. interface
  10. Uses SysUtils, Db, ComObj, ActiveX {$IFDEF D6UP}, Variants{$ENDIF};
  11.  
  12.  
  13.   Function ComposeDateTimeRecord(S:String):TTimeStamp;
  14.   Function ComposeDateTimeVariant(S:String):OleVariant;
  15.   Function RemoveNonDigitChars(DT:String):String;
  16.   Function DaoSizeToBDESize(DaoType:Integer;DaoSize:Integer):Integer;
  17.   Function DaoToBDE(DaoType:Integer):TFieldType;
  18.   Function BDEToDao(BDEType:TFieldType):Integer;
  19.   Function GetBDEFieldTypeNames(BDEType:TFieldType):String;
  20.   Function GetDaoFieldTypeNames(DaoType:Integer):String;
  21.   Function PSafeArrayToOleVariant(PSA: PSafeArray): OleVariant;
  22.   Function OleVariantToPSafeArray(OV: OleVariant):PSafeArray;
  23.   Function BracketField (const FieldName:String) : String;
  24.  
  25.  
  26. implementation
  27. Uses
  28.  DAOApi,Windows,Dialogs,Registry;
  29. Const
  30.  LangGarbage='π.';
  31.  
  32.  
  33. Function PSafeArrayToOleVariant(PSA: PSafeArray): OleVariant;
  34. begin
  35.   TVarData(Result).VType  := varArray;
  36.   TVarData(Result).VArray := PVarArray(PSA);
  37. end;
  38.  
  39.  
  40. Function OleVariantToPSafeArray(OV: OleVariant):PSafeArray;
  41. begin
  42.   Result := PSafeArray (TVarData(OV).VArray);
  43. end;
  44.  
  45. Function ComposeDateTimeRecord(S:String):TTimeStamp;
  46. Var
  47.   P      : Integer;
  48. Begin
  49.   Result.Date := 0;
  50.   Result.Time := 0;
  51.   P:=Pos(' ',S);
  52.   if P = 0 Then Exit;
  53.   Result.Date := StrToInt(Copy(S,1,P-1));
  54.   System.Delete(S,1,P);
  55.   Result.Time := StrToInt(S);
  56. End;
  57.  
  58. Function ComposeDateTimeVariant(S:String):OleVariant;
  59. Var
  60.  DTS    : TTimeStamp;
  61.  P      : Integer;
  62. Begin
  63.  Result := NULL;
  64.  P:=Pos(' ',S);
  65.  if P = 0 Then Exit;
  66.  Try
  67.    DTS.Date := StrToInt(Copy(S,1,P-1));
  68.    System.Delete(S,1,P);
  69.    DTS.Time := StrToInt(S);
  70.    VarClear(Result);
  71.    TVarData(Result).VType := varDate;
  72.    TVarData(Result).vDate:= TimeStampToDateTime(DTS);
  73.  Except
  74.   Result := NULL;
  75.  End;
  76. End;
  77.  
  78. Function RemoveNonDigitChars(DT:String):String;
  79. Var
  80.   Allow  : String;
  81.   X,L,P  : Integer;
  82. Begin
  83.   Result:=DT;
  84.   L:=Length(Result);
  85.   if L=0 Then Exit;                            
  86.   Allow := '1234567890/';
  87.   Allow:=Allow+DateSeparator;
  88.   Allow:=Allow+TimeSeparator;
  89.   //****************************************************** Language Specific
  90.   P:=Pos(LangGarbage,Result);
  91.   if P > 0 Then Delete(Result,P,2);
  92.   //****************************************************** Language Specific
  93.   L:=Length(Result);
  94.   For X:=1 to L do
  95.       Begin
  96.        if Pos(Result[X],Allow)=0 Then Result[X]:=' ';
  97.       End;
  98.   Repeat
  99.     P:= Pos('  ',Result);
  100.     if P > 0 Then Delete(Result,P,1);
  101.   Until P=0;
  102.   Result:=Trim(Result);
  103.   //***************************** Remove any spaces exept between date and time
  104.   P:=Pos(TimeSeparator,Result);
  105.   While (P > 0) And (Result[P] <> ' ') Do Dec(P);
  106.   if P > 0 Then Result[P]:=#0;
  107.   Repeat
  108.     P:= Pos(' ',Result);
  109.     if P > 0 Then Delete(Result,P,1);
  110.   Until P=0;
  111.   P:= Pos(#0,Result);
  112.   if P > 0 Then Result[P]:=' ';
  113. End;
  114.  
  115. Function DaoSizeToBDESize(DaoType:Integer;DaoSize:Integer):Integer;
  116. Begin
  117.  Result:=0;
  118.  Case DaoType of
  119.         dbBoolean        : Result := 0;
  120.         dbByte           : Result := 0;
  121.         dbInteger        : Result := 0;
  122.         dbLong           : Result := 0;
  123.         dbCurrency       : Result := 0;
  124.         dbSingle         : Result := 0;
  125.         dbDouble         : Result := 0;
  126.         dbDate           : Result := 0;
  127.         dbBinary         : Result := DaoSize;
  128.         dbText           : Result := DaoSize;
  129.         dbLongBinary     : Result := DaoSize;
  130.         dbMemo           : Result := DaoSize;
  131.         dbGUID           : Result := DaoSize;
  132.         dbBigInt         : Result := 0;
  133.         dbVarBinary      : Result := DaoSize;
  134.         dbChar           : Result := DaoSize;
  135.         dbNumeric        : Result := 0;
  136.         dbDecimal        : Result := 0;
  137.         dbFloat          : Result := 0;
  138.         dbTime           : Result := 0;
  139.         dbTimeStamp      : Result := 0;
  140.         dbAutoIncInteger : Result := 0;
  141.  End;
  142. End;
  143.  
  144. Function DaoToBDE(DaoType:Integer):TFieldType;
  145. Begin
  146.  Result:=ftUnknown;
  147.  Case DaoType of
  148.         dbBoolean        : Result := ftBoolean;
  149.         dbByte           : Result := ftSmallint;
  150.         dbInteger        : Result := ftSmallint;
  151.         dbLong           : Result := ftInteger;
  152.         dbCurrency       : Result := ftCurrency;
  153.         dbSingle         : Result := ftFloat;
  154.         dbDouble         : Result := ftFloat;
  155.         dbDate           : Result := ftDate;
  156.         dbText           : Result := ftString;
  157.         dbLongBinary     : Result := ftBlob;                                
  158.         dbMemo           : Result := ftMemo;
  159.         //********************************************
  160.         dbBinary         : Result := ftBytes; 
  161.         dbGUID           : Result := ftBytes;
  162.         //********************************************
  163.         dbBigInt         : Result := ftInteger;
  164.         dbVarBinary      : Result := ftBlob;
  165.         dbChar           : Result := ftString;
  166.         dbNumeric        : Result := ftFloat;
  167.         dbDecimal        : Result := ftFloat;
  168.         dbFloat          : Result := ftFloat;
  169.         dbTime           : Result := ftTime;
  170.         dbTimeStamp      : Result := ftDateTime;
  171.         dbAutoIncInteger : Result := ftAutoInc;
  172.  End;
  173. End;
  174.  
  175. Function BDEToDao(BDEType:TFieldType):Integer;
  176. Begin
  177.  Result:=dbUnspecifyed;
  178.  Case BDEType of
  179.         ftString       : Result := dbText;
  180.         ftSmallint     : Result := dbInteger;
  181.         ftInteger      : Result := dbLong;
  182.         ftWord         : Result := dbLong;
  183.         ftBoolean      : Result := dbBoolean;
  184.         ftFloat        : Result := dbSingle;
  185.         ftCurrency     : Result := dbCurrency;
  186.         ftBCD          : Result := dbCurrency;
  187.         ftDate         : Result := dbDate;
  188.         ftTime         : Result := dbDate;
  189.         ftDateTime     : Result := dbDate;
  190.         ftBytes           : Result := dbGUID;
  191.         ftVarBytes     : Result := dbMemo;
  192.         ftAutoInc      : Result := dbAutoIncInteger;
  193.         ftBlob         : Result := dbLongBinary;
  194.         ftMemo         : Result := dbMemo;
  195.         ftGraphic      : Result := dbLongBinary;
  196.         ftFmtMemo      : Result := dbMemo;
  197.         ftParadoxOle   : Result := dbLongBinary    ;
  198.         ftDBaseOle     : Result := dbLongBinary    ;
  199.         ftTypedBinary  : Result := dbLongBinary    ;
  200.       End;
  201. End;
  202.  
  203. Function GetBDEFieldTypeNames(BDEType:TFieldType):String;
  204. Begin
  205.  Result:='ftUnknown';
  206.  Case BDEType of
  207.         ftBoolean    : Result := 'ftBoolean';
  208.         ftInteger    : Result := 'ftInteger';
  209.         ftSmallInt   : Result := 'ftSmallInt';
  210.         ftWord       : Result := 'ftWord';
  211.         ftBCD        : Result := 'ftBCD';
  212.         ftCurrency   : Result := 'ftCurrency';
  213.         ftFloat      : Result := 'ftFloat';
  214.         ftDate       : Result := 'ftDate';
  215.         ftBlob       : Result := 'ftBlob';
  216.         ftString     : Result := 'ftString';
  217.         ftMemo       : Result := 'ftMemo';
  218.         ftAutoInc    : Result := 'ftAutoInc';
  219.         ftTime       : Result := 'ftTime';
  220.         ftDateTime   : Result := 'ftDateTime';
  221.  End;
  222. End;
  223.  
  224. Function GetDaoFieldTypeNames(DaoType:Integer):String;
  225. Begin
  226.  Result:='dbUnknown';
  227.  Case DaoType of
  228.         dbBoolean    : Result := 'dbBoolean';
  229.         dbByte       : Result := 'dbByte';
  230.         dbInteger    : Result := 'dbInteger';
  231.         dbLong       : Result := 'dbLong';
  232.         dbCurrency   : Result := 'dbCurrency';
  233.         dbSingle     : Result := 'dbSingle';
  234.         dbDouble     : Result := 'dbDouble';
  235.         dbDate       : Result := 'dbDate';
  236.         dbBinary     : Result := 'dbBinary';
  237.         dbText       : Result := 'dbText';
  238.         dbLongBinary : Result := 'dbLongBinary';
  239.         dbMemo       : Result := 'dbMemo';
  240.         dbGUID       : Result := 'dbGUID';
  241.         dbBigInt     : Result := 'dbBigInt';
  242.         dbVarBinary  : Result := 'dbVarBinary';
  243.         dbChar       : Result := 'dbChar';
  244.         dbNumeric    : Result := 'dbNumeric';
  245.         dbDecimal    : Result := 'dbDecimal';
  246.         dbFloat      : Result := 'dbFloat';
  247.         dbTime       : Result := 'dbTime';
  248.         dbTimeStamp  : Result := 'dbTimeStamp';
  249.  End;
  250. End;
  251.  
  252. Function BracketField (const FieldName:String) : String;
  253. Var
  254.   P : Integer;
  255.   S : String;
  256. Begin
  257.   Result := '';
  258.   S := FieldName;
  259.   P := Pos('.',S);
  260.   While P > 0 Do
  261.     Begin
  262.       Result := Result+System.Copy(S,1,P-1);
  263.       Result := Result+'].[';
  264.       System.Delete(S,1,P);
  265.       P := Pos('.',S);
  266.     End;
  267.   Result := '['+Result+S+']';
  268. End;
  269.  
  270. end.
  271.