home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / zluUtility.pas < prev   
Pascal/Delphi Source File  |  2000-07-24  |  17KB  |  591 lines

  1. {
  2.  * The contents of this file are subject to the InterBase Public License
  3.  * Version 1.0 (the "License"); you may not use this file except in
  4.  * compliance with the License.
  5.  * 
  6.  * You may obtain a copy of the License at http://www.Inprise.com/IPL.html.
  7.  * 
  8.  * Software distributed under the License is distributed on an "AS IS"
  9.  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  10.  * the License for the specific language governing rights and limitations
  11.  * under the License.  The Original Code was created by Inprise
  12.  * Corporation and its predecessors.
  13.  * 
  14.  * Portions created by Inprise Corporation are Copyright (C) Inprise
  15.  * Corporation. All Rights Reserved.
  16.  * 
  17.  * Contributor(s): ______________________________________.
  18. }
  19.  
  20. {****************************************************************
  21. *
  22. *  z l u U t i l i t y
  23. *
  24. ****************************************************************
  25. *  Author: The Client Server Factory Inc.
  26. *  Date:   March 1, 1999
  27. *
  28. *  Description:  This unit contains utility functions used throughout
  29. *                the application
  30. *
  31. *****************************************************************
  32. * Revisions:
  33. *
  34. *****************************************************************}
  35.  
  36. unit zluUtility;
  37.  
  38. interface
  39.  
  40. uses
  41.   Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls,
  42.   FileCtrl, Registry, IBDatabase, IBSQL;
  43.  
  44. function CheckDirectory(Directory: string): boolean;
  45. function GetNewFileName(Directory: string; FileExtension: string): string;
  46. function GetNextField(var InputStr: string; const FieldDelimiter: string): string;
  47. function IsIBRunning(): boolean;
  48. function IsServerRegistered(const Alias: String): boolean;
  49. function OSVersionInfo(): DWORD;
  50. function RemoveControlChars(const InputStr: string): string;
  51. function StartGuardian(): boolean;
  52. function StartServer(): boolean;
  53. function StopServer(): boolean;
  54. function ParseConnectStr(Str, Tok, Del : String) : String;
  55. function ConvertStr(lStr : String) : String;
  56. function ObjTypeToStr(const objType: integer): string;
  57. function StripMenuChars(const Caption: String): String;
  58. function GetImageIndex (const ObjType: integer): integer;
  59. function Max (const val1, val2: integer): integer;
  60. function IsValidDBName(const DBName: String): boolean;
  61.  
  62. implementation
  63.  
  64. uses
  65.   zluGlobal, frmuMessage, IBHeader;
  66.  
  67. {****************************************************************
  68. *
  69. *  C h e c k D i r e c t o r y ()
  70. *
  71. ****************************************************************
  72. *  Author: The Client Server Factory Inc.
  73. *  Date:   May 9, 1999
  74. *
  75. *  Input:
  76. *
  77. *  Return:
  78. *
  79. *  Description:
  80. *
  81. *****************************************************************
  82. * Revisions:
  83. *
  84. *****************************************************************}
  85. function CheckDirectory(Directory: string): boolean;
  86. begin
  87.   if (Directory <> '') and not (DirectoryExists(Directory)) then
  88.   begin
  89.     if MessageDlg(Format('The directory %s does not exist. Do you wish to create it?',[Directory]),
  90.       mtConfirmation, [mbYes,mbNo], 0) = mrYes then
  91.     begin
  92.       if not CreateDir(Directory) then
  93.       begin
  94.         MessageDlg(Format('An error occurred while attemting to create directory %s. Operation cancelled.',[Directory]),
  95.           mtInformation, [mbOk], 0);
  96.         result := false;
  97.       end
  98.       else
  99.         result := true;
  100.     end
  101.     else
  102.       result := false;
  103.   end
  104.   else
  105.     result := true;
  106. end;
  107.  
  108. {****************************************************************
  109. *
  110. *  G e t N e w F i l e N a m e ()
  111. *
  112. ****************************************************************
  113. *  Author: The Client Server Factory Inc.
  114. *  Date:   May 9, 1999
  115. *
  116. *  Input:
  117. *
  118. *  Return:
  119. *
  120. *  Description:
  121. *
  122. *****************************************************************
  123. * Revisions:
  124. *
  125. *****************************************************************}
  126. function GetNewFileName(Directory: string; FileExtension: string): string;
  127. var
  128.   lFileName: string;
  129. begin
  130.   Randomize;
  131.   lFileName := Format('%s%s%s',[Directory,Format('%-8.8d',[Random(99999999)]),FileExtension]);
  132.   while FileExists(lFileName) do
  133.   begin
  134.     lFileName := Format('%s%s%s',[Directory,Format('%-8.8d',[Random(99999999)]),FileExtension]);
  135.   end;
  136.   result := lFileName;
  137. end;
  138.  
  139. {****************************************************************
  140. *
  141. *  G e t N e x t F i e l d ()
  142. *
  143. ****************************************************************
  144. *  Author: The Client Server Factory Inc.
  145. *  Date:   March 1, 1999
  146. *
  147. *  Input:  InputStr - The string to process
  148. *          FieldDelimiter - The field delimiter to use
  149. *
  150. *  Return: string - The extracted string
  151. *
  152. *  Description:  Receives a delimited string and extracts the
  153. *                first field in the string based on the given delimiter
  154. *
  155. *****************************************************************
  156. * Revisions:
  157. *
  158. *****************************************************************}
  159. function GetNextField(var InputStr: string; const FieldDelimiter: string): string;
  160. var
  161.   lFieldDelPos: integer;
  162.   lRetVal: string;
  163. begin
  164.   // get position of the first Delimiter found
  165.   lFieldDelPos := Pos(FieldDelimiter, InputStr);
  166.   if lFieldDelPos > 0 then
  167.   begin
  168.     // copy the field to a new string
  169.     lRetVal := Copy(InputStr, 1, lFieldDelPos - 1);
  170.  
  171.     // delete field from our incoming string
  172.     Delete(InputStr, 1, lFieldDelPos + Length(FieldDelimiter)-1);
  173.   end
  174.   else
  175.   begin
  176.     // last field
  177.     lRetVal := InputStr;
  178.     InputStr := '';
  179.   end;
  180.   result := Trim(lRetVal);
  181. end;
  182.  
  183. {****************************************************************
  184. *
  185. *  I s R u n n i n g ( )
  186. *
  187. ****************************************************************
  188. *  Author: The Client Server Factory Inc.
  189. *  Date:   March 1, 1999
  190. *
  191. *  Input:
  192. *
  193. *  Return:
  194. *
  195. *  Description:
  196. *
  197. *****************************************************************
  198. * Revisions:
  199. *
  200. *****************************************************************}
  201. function IsIBRunning(): boolean;
  202. begin
  203.   if GetWindow(GetDesktopWindow,GW_HWNDNEXT)= FindWindow('IB_Server', 'InterBase Server') then
  204.     result := false
  205.   else
  206.     result := true;
  207. end;
  208.  
  209. {****************************************************************
  210. *
  211. *  O S V e r s i o n I n f o ( )
  212. *
  213. ****************************************************************
  214. *  Author: The Client Server Factory Inc.
  215. *  Date:   March 1, 1999
  216. *
  217. *  Input:
  218. *
  219. *  Return:
  220. *
  221. *  Description:
  222. *
  223. *****************************************************************
  224. * Revisions:
  225. *
  226. *****************************************************************}
  227. function OSVersionInfo(): DWORD;
  228. var
  229.   lVersion: Windows.OSVERSIONINFO;
  230. begin
  231.   ZeroMemory(@lVersion, SizeOf(lVersion));
  232.   lVersion.dwOSVersionInfoSize := sizeof(lVersion);
  233.   GetVersionEx(lVersion);
  234.   result := lVersion.dwPlatformId
  235. end;
  236.  
  237. {****************************************************************
  238. *
  239. *  R e m o v e C o n t r o l C h a r s ()
  240. *
  241. ****************************************************************
  242. *  Author: The Client Server Factory Inc.
  243. *  Date:   March 1, 1999
  244. *
  245. *  Input:  InputStr - The string to process
  246. *
  247. *  Return: string - The processed string
  248. *
  249. *  Description:  Receives a string and removes any control
  250. *                characters from it
  251. *
  252. *****************************************************************
  253. * Revisions:
  254. *
  255. *****************************************************************}
  256. function RemoveControlChars(const InputStr: string): string;
  257. var
  258.   i: integer;
  259.   lStrVal: string;
  260. begin
  261.   lStrVal := Trim(InputStr);
  262.   for i := 0 to Length(lStrVal) - 1 do
  263.   begin
  264.     if (Ord(lStrVal[i]) in [32..126]) then
  265.     begin
  266.       // The lStrVal[i+1] is safe in this case because with the use
  267.       // of the above Trim() function the if condition will never be true for
  268.       // the last character.
  269.       if (lStrVal[i] = Chr(32)) and (lStrVal[i+1] = Chr(32)) then
  270.         Delete(lStrVal,i,1);
  271.     end;
  272.   end;
  273.   { Make sure that the first character is capitalized }
  274.   if Length(lStrVal) > 0 then
  275.     lStrVal[1] := UpCase(lStrVal[1]);
  276.   result := lStrVal;
  277. end;
  278.  
  279. {****************************************************************
  280. *
  281. *  S t a r t G u a r d i a n ( )
  282. *
  283. ****************************************************************
  284. *  Author: The Client Server Factory Inc.
  285. *  Date:   March 1, 1999
  286. *
  287. *  Input:
  288. *
  289. *  Return:
  290. *
  291. *  Description:
  292. *
  293. *****************************************************************
  294. * Revisions:
  295. *
  296. *****************************************************************}
  297. function StartGuardian(): boolean;
  298. var
  299.   lRegistry: TRegistry;
  300.   lEXEName: string;
  301.   lArray: array[0..255] of char;
  302. begin
  303.   result := false;
  304.   lRegistry := TRegistry.Create;
  305.   try
  306.     Screen.Cursor := crHourglass;
  307.     lRegistry.RootKey := HKEY_LOCAL_MACHINE;
  308.     if not lRegistry.OpenKey('Software\Borland\InterBase\CurrentVersion',False) then
  309.       ShowMessage('InterBase server is not installed on your computer.')
  310.     else
  311.       lEXEName := Format('%s%s ',[lRegistry.ReadString('ServerDirectory'),'ibguard.exe']);
  312.   finally
  313.     if WinExec(StrPCopy(lArray,lEXEName),1) > 31 then
  314.       result := true;
  315.     lRegistry.Free;
  316.     Screen.Cursor := crDefault;
  317.   end;
  318. end;
  319.  
  320. {****************************************************************
  321. *
  322. *  S t a r t S e r v e r ( )
  323. *
  324. ****************************************************************
  325. *  Author: The Client Server Factory Inc.
  326. *  Date:   March 1, 1999
  327. *
  328. *  Input:
  329. *
  330. *  Return:
  331. *
  332. *  Description:
  333. *
  334. *****************************************************************
  335. * Revisions:
  336. *
  337. *****************************************************************}
  338. function StartServer(): boolean;
  339. var
  340.   lRegistry: TRegistry;
  341.   lStartUpInfo: STARTUPINFO;
  342.   lSecurityAttr: SECURITY_ATTRIBUTES;
  343.   lProcessInfo: PROCESS_INFORMATION;
  344.   lEXEName: string;
  345.   lArray: array[0..255] of char;
  346. begin
  347.   result := false;
  348.   lRegistry := TRegistry.Create;
  349.   try
  350.     Screen.Cursor := crHourglass;
  351.     lRegistry.RootKey := HKEY_LOCAL_MACHINE;
  352.     if not lRegistry.OpenKey('Software\Borland\InterBase\CurrentVersion',False) then
  353.       ShowMessage('InterBase server is not installed on your system.')
  354.     else
  355.       lEXEName := Format('%s%s -a',[lRegistry.ReadString('ServerDirectory'),'ibserver.exe']);
  356.  
  357.     ZeroMemory(@lStartUpInfo, SizeOf(lStartUpInfo));
  358.     lStartUpInfo.cb := SizeOf(lStartUpInfo);
  359.     lSecurityAttr.nLength := SizeOf (lSecurityAttr);
  360.     lSecurityAttr.lpSecurityDescriptor := nil;
  361.     lSecurityAttr.bInheritHandle := TRUE;
  362.     if CreateProcess (nil,StrPCopy(lArray,lEXEName), @lSecurityAttr, nil, FALSE, 0, nil,
  363.       nil, lStartUpInfo, lProcessInfo) <> Null then
  364.       result := true
  365.     else
  366.       ShowMessage('The server could not be started.')
  367.   finally
  368.     lRegistry.Free;
  369.     Screen.Cursor := crDefault;
  370.   end;
  371. end;
  372.  
  373. {****************************************************************
  374. *
  375. *  S t o p S e r v e r ( )
  376. *
  377. ****************************************************************
  378. *  Author: The Client Server Factory Inc.
  379. *  Date:   March 1, 1999
  380. *
  381. *  Input:
  382. *
  383. *  Return:
  384. *
  385. *  Description:
  386. *
  387. *****************************************************************
  388. * Revisions:
  389. *
  390. *****************************************************************}
  391. function StopServer(): boolean;
  392. var
  393.   lHWND: HWND;
  394.   lVersion: DWORD;
  395.   lRegistry: TRegistry;
  396.   lEXEName: string;
  397.   lArray: array[0..255] of char;
  398. begin
  399.   result := false;
  400.   lRegistry := TRegistry.Create;
  401.   try
  402.     Screen.Cursor := crHourglass;
  403.     lVersion := OSVersionInfo();
  404.     if lVersion = VER_PLATFORM_WIN32_NT then
  405.     begin
  406.       lRegistry.RootKey := HKEY_LOCAL_MACHINE;
  407.       if not lRegistry.OpenKey('Software\Borland\InterBase\CurrentVersion',False) then
  408.         ShowMessage('InterBase server is not installed on your system.')
  409.       else
  410.         lEXEName := Format('%s%s',[lRegistry.ReadString('ServerDirectory'),'instsvc.exe stop']);
  411.  
  412.       if WinExec(StrPCopy(lArray,lEXEName), 2) > 31 then
  413.         result := true;
  414.     end
  415.     else if lVersion = VER_PLATFORM_WIN32_WINDOWS then
  416.     begin
  417.       lHWND:= FindWindow('IB_Server', 'InterBase Server');
  418.       if PostMessage(lHWND, WM_CLOSE, 0, 0)<> Null then
  419.         result := true;
  420.       Application.ProcessMessages;
  421.     end;
  422.   finally
  423.     lRegistry.Free;
  424.     Screen.Cursor := crDefault;
  425.   end;
  426. end;
  427.  
  428. // extracts param values for a connect statememt
  429. function ParseConnectStr(Str, Tok, Del : String) : String;
  430.   var
  431.     iStart, iEnd : Integer;
  432.     lReturn : String;
  433.   begin
  434.     iStart := Pos(Tok, Str);
  435.     // found parameter - must find parameter value
  436.     if iStart <> 0 then
  437.     begin
  438.       Delete(Str, 1, iStart);
  439.       iEnd := Pos(Del, Str);
  440.       if iEnd <> 0 then
  441.       begin
  442.         // delete the parameter - next is the parameter value
  443.         Delete(Str, 1, iEnd);
  444.  
  445.         iEnd := Pos(Del, Str);
  446.  
  447.         if iEnd <> 0 then
  448.           lReturn := Trim(Copy(Str, 0, iEnd - 1))
  449.         else
  450.           lReturn := '';
  451.       end
  452.       else
  453.         lReturn := '';
  454.     end
  455.     else
  456.       lReturn := '';
  457.     Result := lReturn;
  458.   end;
  459.  
  460.   // this function removes ' and replaces them with "
  461.   // and converts all non-quoted characters to uppercase
  462. function ConvertStr(lStr : String) : String;
  463.   var
  464.     lQuote : Boolean;
  465.     i : Integer;
  466.   begin
  467.     lStr := Trim(lStr);
  468.     lQuote := False;
  469.     i := 1;
  470.     while i <= Length(lStr) do
  471.     begin
  472.       if (Ord(lStr[i]) = 10) or (Ord(lStr[i]) = 13) then
  473.         lStr[i] := ' '
  474.       else  if (lStr[i] = '''') or (lStr[i] = '"') then
  475.       begin
  476.         if (lStr[i] = '''') then
  477.           lStr[i] := '"';
  478.         if lQuote then
  479.           lQuote := False
  480.         else
  481.           lQuote := True;
  482.       end
  483.       else
  484.       begin
  485.         if (not lQuote) and (Ord(lStr[i]) > 96) and (Ord(lStr[i]) < 123) then
  486.         begin
  487.           lStr[i] := Chr(Ord(lStr[i]) - 32)
  488.         end;
  489.       end;
  490.       Inc(i);
  491.     end;
  492.     Result := lStr;
  493.   end;
  494.  
  495. function ObjTypeToStr(const objType: integer): string;
  496. begin
  497.   case objType of
  498.     0: result := 'Table';
  499.     1: result := 'View';
  500.     2: result := 'Trigger';
  501.     3: result := 'Computed Field';
  502.     4: result := 'Validation';
  503.     5: result := 'Procedure';
  504.     6: result := 'Expression Index';
  505.     7: result := 'Exception';
  506.     8: result := 'User';
  507.     9: result := 'Field';
  508.     10: result := 'Index';
  509.     13: result := 'Role';
  510.     else
  511.       result := 'Unknown';
  512.   end;
  513. end;
  514.  
  515. function StripMenuChars(const Caption: String): String;
  516. var
  517.   Psrc, Pdest: PChar;
  518.   dest_str: String;
  519. begin
  520.   Psrc := PChar(Caption);
  521.   SetLength(dest_str, Length(Caption));
  522.   Pdest := PChar(dest_str);
  523.   while Psrc^ <> #0 do
  524.   begin
  525.     if not (Psrc^ in ['&', '.']) then
  526.     begin
  527.       Pdest^ := Psrc^;
  528.       Inc(Pdest);
  529.     end;
  530.     Inc(Psrc);
  531.   end;
  532.   Pdest^ := PSrc^;
  533.   result := dest_str;
  534. end;
  535.  
  536. function GetImageIndex (const ObjType: integer): integer;
  537. begin
  538.   case ObjType of
  539.     DEP_TABLE: result := NODE_TABLES_IMG;
  540.     DEP_VIEW:  result := NODE_VIEWS_IMG;
  541.     DEP_TRIGGER: result := NODE_TRIGGERS_IMG;
  542.     DEP_COMPUTED_FIELD: result := NODE_UNK_IMG;
  543.     DEP_VALIDATION: result := NODE_CHECK_CONSTRAINTS_IMG;
  544.     DEP_PROCEDURE: result := NODE_PROCEDURES_IMG;
  545.     DEP_EXPRESSION_INDEX: result := NODE_UNK_IMG;
  546.     DEP_EXCEPTION: result := NODE_EXCEPTIONS_IMG;
  547.     DEP_USER: result := NODE_USERS_IMG;
  548.     DEP_FIELD: result := NODE_COLUMNS_IMG;
  549.     DEP_INDEX: result := NODE_INDEXES_IMG;
  550.     else
  551.       result := NODE_UNK_IMG;
  552.   end;
  553. end;
  554.  
  555. function IsServerRegistered(const Alias: String): boolean;
  556. var
  557.   Reg: TRegistry;
  558. begin
  559.   Reg := TRegistry.Create;
  560.   with Reg do
  561.   begin
  562.     result := OpenKey(Format('%s%s',[gRegServersKey,Alias]), false);
  563.     Free;
  564.   end;
  565. end;
  566.  
  567. function Max (const val1, val2: integer): integer;
  568. begin
  569.   if val1 > val2 then
  570.     result := val1
  571.   else
  572.     result := val2;
  573. end;
  574.  
  575. function IsValidDBName(const DBName: String): boolean;
  576. (* NOTE:  If this function returns FALSE, all areas of the code
  577.    return a warning and DO NOT ABORT *)
  578. begin
  579.   result := true;
  580.   { Make sure it is not a UNC name }
  581.   if (Pos('//', DBName) = 1) or
  582.      (Pos ('\\', DBName) = 1) or
  583.   { Make sure it is not TCP/IP }
  584.      (Pos(':', DBName) > 2) or
  585.   { Make sure it is not SPX.}
  586.      (Pos('@', DBName) <> 0) then
  587.     result := false;
  588. end;
  589.  
  590. end.
  591.