home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Delphi.5 / Samples / sourceD5 / browutil.exe / BROWSER / GENFUNC.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-07-25  |  12.8 KB  |  405 lines
  1. unit GenFunc;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, DB, DBTables, Forms, FileCtrl, DBGrids, Controls,
  7.   Dialogs, StdCtrls, ShellAPI, Inifiles, Literals;
  8.  
  9. type
  10.   TFields = record
  11.     FieldNames : Array [0..500] of String;
  12.     FieldValues : Array [0..500] of String;
  13.   end;
  14.   TTableRecords = record
  15.     Fields : Array [0..1000] of TFields;
  16.     TotalRecords : Integer;
  17.   end;
  18.  
  19. var
  20.   sWorkingDirectory, sTempDrive, sIF_Browser : String;
  21.  
  22. function FindFieldType(wDataType : TFieldType) : String;
  23. procedure Scatter(tblSourceTable : TTable; var aTableStructure, aFieldContent : Array of String);
  24. procedure Gather(tblSourceTable : TTable; var aTableStructure, aFieldContent : Array of String);
  25. procedure MultiScatter(tblSourceTable : TTable; DBGrid : TDBGrid; var TableRecords : TTableRecords);
  26. procedure MultiGather(tblSourceTable : TTable; var TableRecords : TTableRecords);
  27. procedure Initialise(Application : TApplication);
  28. procedure SetDateFormatForFields(tblSource : TTable);
  29. procedure AssignGridOptions(DBGrid1 : TDBGrid; goGridOption : TDBGridOption; lFlag : Boolean);
  30. procedure ShowTerminateMsg;
  31. function FieldTypeToString(FieldType : TFieldType) : String;
  32. procedure AssignNetFileDir(sPath : String);
  33. function DeleteFiles(ListBox : TListBox; lConfirm : Boolean; sDirectory : String) : Boolean;
  34. function DecryptString(sString : String) : String;
  35. function EncryptString(sString : String) : String;
  36. procedure ShellError(nResult : Integer);
  37. function SaveToIni(sINIFile, sSection, sID, sValue : String) : Boolean;
  38. function ReadFromIni(sINIFile, sSection, sID, sDefaultValue : String) : String;
  39. function DeleteFromIni(sINIFile, sSection : String) : Boolean;
  40.  
  41. implementation
  42.  
  43. procedure Initialise(Application : TApplication);
  44. var
  45.   sExeName : String;
  46. begin
  47.   sExeName := Application.ExeName;
  48.   sWorkingDirectory := ExtractFilePath(sExeName);
  49.   sTempDrive := sWorkingDirectory + 'Temp\';
  50.   if not DirectoryExists(sTempDrive) then
  51.     CreateDir(sTempDrive);
  52.   sIF_Browser := ExtractFilePath(Application.ExeName)+IF_Browser;
  53. end;
  54.  
  55. function FindFieldType(wDataType : TFieldType) : String;
  56. var
  57.   sFieldType : String;
  58. begin
  59.   if wDataType in [ftString] then
  60.     sFieldType := 'String';
  61.   if wDataType in [ftSmallint] then
  62.     sFieldType := 'Smallint';
  63.   if wDataType in [ftInteger] then
  64.     sFieldType := 'Integer';
  65.   if wDataType in [ftWord] then
  66.     sFieldType := 'Word';
  67.   if wDataType in [ftBoolean] then
  68.     sFieldType := 'Boolean';
  69.   if wDataType in [ftFloat] then
  70.     sFieldType := 'Float';
  71.   if wDataType in [ftCurrency] then
  72.     sFieldType := 'Currency';
  73.   if wDataType in [ftBCD] then
  74.     sFieldType := 'BCD';
  75.   if wDataType in [ftDate] then
  76.     sFieldType := 'Date';
  77.   if wDataType in [ftTime] then
  78.     sFieldType := 'Time';
  79.   if wDataType in [ftDateTime] then
  80.     sFieldType := 'DateTime';
  81.   if wDataType in [ftBytes] then
  82.     sFieldType := 'Bytes';
  83.   if wDataType in [ftVarBytes] then
  84.     sFieldType := 'VarBytes';
  85.   if wDataType in [ftAutoInc] then
  86.     sFieldType := 'AutoInc';
  87.   if wDataType in [ftBlob] then
  88.     sFieldType := 'Blob';
  89.   if wDataType in [ftMemo] then
  90.     sFieldType := 'Memo';
  91.   if wDataType in [ftGraphic] then
  92.     sFieldType := 'Graphic';
  93.   if wDataType in [ftFmtMemo] then
  94.     sFieldType := 'FmtMemo';
  95.   if wDataType in [ftParadoxOle] then
  96.     sFieldType := 'ParadoxOle';
  97.   if wDataType in [ftDBaseOle] then
  98.     sFieldType := 'DBaseOle';
  99.   if wDataType in [ftTypedBinary] then
  100.     sFieldType := 'TypedBinary';
  101.   if wDataType in [ftBlob] then
  102.     sFieldType := 'BLOB';
  103.   Result := sFieldType;
  104. end;
  105.  
  106. procedure SetDateFormatForFields(tblSource : TTable);
  107. var
  108.   i : Integer;
  109. begin
  110.   try
  111.     tblSource.FieldDefs.Update;
  112.     for i := 0 to tblSource.FieldDefs.Count - 1 do begin
  113.       if (tblSource.FindField(tblSource.FieldDefs.Items[I].Name) <> nil) and (tblSource.FindField(tblSource.FieldDefs.Items[I].Name).DataType = ftDate) then
  114.         tblSource.FindField(tblSource.FieldDefs.Items[I].Name).EditMask := '99/99/9999';
  115.     end;
  116.   except
  117.     raise;
  118.   end;
  119. end;
  120.  
  121. procedure AssignGridOptions(DBGrid1 : TDBGrid; goGridOption : TDBGridOption; lFlag : Boolean);
  122. begin
  123.   if lFlag then
  124.     DBGrid1.Options := DBGrid1.Options + [goGridOption]
  125.   else
  126.     DBGrid1.Options := DBGrid1.Options - [goGridOption];
  127. end;
  128.  
  129. procedure ShowTerminateMsg;
  130. begin
  131.   MessageBeep(mb_Ok);
  132.   ShowMessage('Terminated');
  133. end;
  134.  
  135. procedure Scatter(tblSourceTable : TTable; var aTableStructure, aFieldContent : Array of String);
  136. var
  137.   I : Integer;
  138. begin
  139.   for I := 0 to tblSourceTable.FieldDefs.Count - 1 do begin
  140.     aTableStructure[I] := tblSourceTable.FieldDefs.Items[I].Name;
  141.     aFieldContent[I] := tblSourceTable.FieldByName(aTableStructure[I]).AsString;
  142.   end;
  143. end;
  144.  
  145. procedure Gather(tblSourceTable : TTable; var aTableStructure, aFieldContent : Array of String);
  146. var
  147.   I : Integer;
  148. begin
  149.   if not (tblSourceTable.State in [dsInsert,dsEdit]) then
  150.     if (MessageDlg('Add Record',mtConfirmation,[mbYes,mbNo],0) = mrYes) then
  151.       tblSourceTable.Append
  152.     else
  153.       Exit;
  154.   for I := Low(aTableStructure) to High(aTableStructure) do begin
  155.     if (tblSourceTable.FindField(aTableStructure[I]) <> nil) and (tblSourceTable.FindField(aTableStructure[I]).DataType <> ftAutoInc) then
  156.       tblSourceTable.FieldByName(aTableStructure[I]).AsString := aFieldContent[I];
  157.   end;
  158. end;
  159.  
  160. procedure MultiScatter(tblSourceTable : TTable; DBGrid : TDBGrid; var TableRecords : TTableRecords);
  161. var
  162.   I, J : Integer;
  163.   bmSourceTable : TBookMark;
  164. begin
  165.   bmSourceTable := tblSourceTable.GetBookmark;
  166.   tblSourceTable.First;
  167.   I := 0;
  168.   J := 0;
  169.   tblSourceTable.DisableControls;
  170.   try
  171.     I := 0;
  172.     while not tblSourceTable.EOF do begin
  173.       if DBGrid.SelectedRows.CurrentRowSelected then begin
  174.         for J := 0 to tblSourceTable.FieldDefs.Count - 1 do begin
  175.           TableRecords.Fields[I].FieldNames[J] := tblSourceTable.FieldDefs.Items[J].Name;
  176.           TableRecords.Fields[I].FieldValues[J] := tblSourceTable.FieldByName(TableRecords.Fields[I].FieldNames[J]).AsString;
  177.         end;
  178.         I := I + 1;
  179.       end;
  180.       tblSourceTable.Next;
  181.     end;
  182.     TableRecords.TotalRecords := I+1;
  183.   except
  184.     on E:EDataBaseError do begin
  185.       MessageBeep(mb_Ok);
  186.       ShowMessage('MultiGather');
  187.     end;
  188.   end;
  189.   try
  190.     tblSourceTable.GotoBookMark(bmSourceTable);
  191.   except
  192.     ;
  193.   end;
  194.   tblSourceTable.FreeBookmark(bmSourceTable);
  195.   tblSourceTable.EnableControls;
  196. end;
  197.  
  198. procedure MultiGather(tblSourceTable : TTable; var TableRecords : TTableRecords);
  199. var
  200.   I, J : Integer;
  201. begin
  202.   I := 0;
  203.   J := 0;
  204.   tblSourceTable.DisableControls;
  205.   try
  206.     if not (tblSourceTable.State in [dsInsert,dsEdit]) then begin
  207.       if (MessageDlg('Add Records',mtConfirmation,[mbYes,mbNo],0) = mrNo) then
  208.         Exit;
  209.     end;
  210.     for I := Low(TableRecords.Fields) to High(TableRecords.Fields) do begin
  211.       if I >= (TableRecords.TotalRecords - 1) then
  212.         Break;
  213.       tblSourceTable.Append;
  214.       for J := Low(TableRecords.Fields[I].FieldNames) to High(TableRecords.Fields[I].FieldNames) do begin
  215.         if (tblSourceTable.FindField(TableRecords.Fields[I].FieldNames[J]) <> nil) and (tblSourceTable.FindField(TableRecords.Fields[I].FieldNames[J]).DataType <> ftAutoInc) then
  216.           tblSourceTable.FieldByName(TableRecords.Fields[I].FieldNames[J]).AsString := TableRecords.Fields[I].FieldValues[J];
  217.       end;
  218.       tblSourceTable.Post;
  219.     end;
  220.   except
  221.     on E:EDataBaseError do begin
  222.       MessageBeep(mb_Ok);
  223.       ShowMessage('MultiGather');
  224.     end;
  225.   end;
  226.   tblSourceTable.EnableControls;
  227. end;
  228.  
  229. function FieldTypeToString(FieldType : TFieldType) : String;
  230. var
  231.   sFieldType : String;
  232. begin
  233.   sFieldType := '';
  234.   if FieldType in [ftString] then
  235.     sFieldType := 'String';
  236.   if FieldType in [ftSmallint] then
  237.     sFieldType := 'Smallint';
  238.   if FieldType in [ftInteger] then
  239.     sFieldType := 'Integer';
  240.   if FieldType in [ftWord] then
  241.     sFieldType := 'Word';
  242.   if FieldType in [ftBoolean] then
  243.     sFieldType := 'Boolean';
  244.   if FieldType in [ftFloat] then
  245.     sFieldType := 'Float';
  246.   if FieldType in [ftCurrency] then
  247.     sFieldType := 'Currency';
  248.   if FieldType in [ftBCD] then
  249.     sFieldType := 'BCD';
  250.   if FieldType in [ftDate] then
  251.     sFieldType := 'Date';
  252.   if FieldType in [ftTime] then
  253.     sFieldType := 'Time';
  254.   if FieldType in [ftDateTime] then
  255.     sFieldType := 'DateTime';
  256.   if FieldType in [ftBytes] then
  257.     sFieldType := 'Bytes';
  258.   if FieldType in [ftVarBytes] then
  259.     sFieldType := 'VarBytes';
  260.   if FieldType in [ftAutoInc] then
  261.     sFieldType := 'AutoInc';
  262.   if FieldType in [ftBlob] then
  263.     sFieldType := 'Blob';
  264.   if FieldType in [ftMemo] then
  265.     sFieldType := 'Memo';
  266.   if FieldType in [ftGraphic] then
  267.     sFieldType := 'Graphic';
  268.   if FieldType in [ftFmtMemo] then
  269.     sFieldType := 'FmtMemo';
  270.   if FieldType in [ftParadoxOle] then
  271.     sFieldType := 'ParadoxOle';
  272.   if FieldType in [ftDBaseOle] then
  273.     sFieldType := 'DBaseOle';
  274.   if FieldType in [ftTypedBinary] then
  275.     sFieldType := 'TypedBinary';
  276.   if FieldType in [ftUnknown] then
  277.     sFieldType := 'Unkown';
  278.   Result := sFieldType;
  279. end;
  280.  
  281. procedure AssignNetFileDir(sPath : String);
  282. begin
  283.   Session.NetFileDir := sPath;
  284. end;
  285.  
  286. function DeleteFiles(ListBox : TListBox; lConfirm : Boolean; sDirectory : String) : Boolean;
  287. var
  288.   I : Integer;
  289. begin
  290.   if (ListBox.SelCount <= 0) then
  291.     Exit;
  292.   if lConfirm and (MessageDlg('Delete File',mtWarning,[mbYes,mbNo],0) <> mrYes) then
  293.     Exit;
  294.   for I := 0 to ListBox.Items.Count - 1 do begin
  295.     if ListBox.Selected[I] and FileExists(ListBox.Items[I]) then
  296.       if not DeleteFile(sDirectory + ListBox.Items[I]) then begin
  297.         MessageBeep(mb_Ok);
  298.         ShowMessage('Error Deleting File ' + ListBox.Items[I]);
  299.       end
  300.   end;
  301. end;
  302.  
  303. function DecryptString(sString : String) : String;
  304. var
  305.   i : Integer;
  306. begin
  307.   for i := 1 to Length(sString) do begin
  308.     sString[i] := Chr(Ord(sString[i])+10);
  309.   end;
  310.   Result := sString;
  311. end;
  312.  
  313. function EncryptString(sString : String) : String;
  314. var
  315.   i : Integer;
  316. begin
  317.   for i := 1 to Length(sString) do begin
  318.     sString[i] := Chr(Ord(sString[i])-10);
  319.   end;
  320.   Result := sString;
  321. end;
  322.  
  323. procedure ShellError(nResult : Integer);
  324. var
  325.   sErrMsg : String;
  326. begin
  327.   sErrMsg := '';
  328.   MessageBeep(mb_Ok);
  329.   case nResult of 
  330.     0                       : sErrMsg := 'The operating system is out of memory or resources.';
  331.     ERROR_FILE_NOT_FOUND   : sErrMsg := 'The specified file was not found.';
  332.     SE_ERR_FNF or ERROR_PATH_NOT_FOUND   : sErrMsg := 'The specified path was not found.' + ' / ' + 'The specified file was not found.';
  333.     ERROR_BAD_FORMAT       : sErrMsg := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
  334.     SE_ERR_ACCESSDENIED       : sErrMsg := 'The operating system denied access to the specified file.';
  335.     SE_ERR_ASSOCINCOMPLETE : sErrMsg := 'The filename association is incomplete or invalid.';
  336.     SE_ERR_DDEBUSY       : sErrMsg := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
  337.     SE_ERR_DDEFAIL       : sErrMsg := 'The DDE transaction failed.';
  338.     SE_ERR_DDETIMEOUT       : sErrMsg := 'The DDE transaction could not be completed because the request timed out.';
  339.     SE_ERR_DLLNOTFOUND       : sErrMsg := 'The specified dynamic-link library was not found.';
  340. //    SE_ERR_FNF         : sErrMsg := 'The specified file was not found.';
  341.     SE_ERR_NOASSOC       : sErrMsg := 'There is no application associated with the given filename extension.';
  342.     SE_ERR_OOM               : sErrMsg := 'There was not enough memory to complete the operation.';
  343. //    SE_ERR_PNF         : sErrMsg := 'The specified path was not found.';
  344.     SE_ERR_SHARE       : sErrMsg := 'A sharing violation occurred.';
  345.   else
  346.     sErrMsg := 'Error running application';
  347.   end;
  348.   ShowMessage(sErrMsg);
  349. end;
  350.  
  351. function SaveToIni(sINIFile, sSection, sID, sValue : String) : Boolean;
  352. var
  353.   INIFile : TIniFile;
  354. begin
  355.   Result := True;
  356.   try
  357.     try
  358.       INIFile := TIniFile.Create(sINIFile);
  359.       INIFile.WriteString(sSection,sID,sValue);
  360.     except
  361.       Result := False;
  362.     end
  363.   finally
  364.     INIFile.Free;
  365.     INIFile := nil;
  366.   end;
  367. end;
  368.  
  369. function ReadFromIni(sINIFile, sSection, sID, sDefaultValue : String) : String;
  370. var
  371.   INIFile : TIniFile;
  372. begin
  373.   try
  374.     try
  375.       INIFile := TIniFile.Create(sINIFile);
  376.       Result := INIFile.ReadString(sSection, sID, sDefaultValue);
  377.     except
  378.       Result := '';
  379.     end;
  380.   finally
  381.     INIFile.Free;
  382.     INIFile := nil;
  383.   end;
  384. end;
  385.  
  386. function DeleteFromIni(sINIFile, sSection : String) : Boolean;
  387. var
  388.   INIFile : TIniFile;
  389. begin
  390.   Result := True;
  391.   try
  392.     try
  393.       INIFile := TIniFile.Create(sINIFile);
  394.       INIFile.EraseSection(sSection);
  395.     except
  396.       Result := False;
  397.     end;
  398.   finally
  399.     INIFile.Free;
  400.     INIFile := nil;
  401.   end;
  402. end;
  403.  
  404. end.
  405.