home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue47 / IntBase / frs_IBStartParams.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-06-01  |  10.7 KB  |  380 lines
  1. unit frs_IBStartParams;
  2.  
  3. {*************************************************************************
  4. *                                                                        *
  5. * UNIT:           frs_IBStartParams.pas                                  *
  6. *                                                                        *
  7. * DESCRIPTION:      This unit encapsulates standard requirements for       *
  8. *                 reading of startup params. It has been tailored        *
  9. *                 specifically to work with InterBase.                   *
  10. *                                                                        *
  11. * AUTHOR:         Paul Reeves                                            *
  12. *                 Fleet River Software                                   *
  13. *                 http://www.fleetriver.demon.co.uk                      *
  14. *                                                                        *
  15. *                 Copyright Paul Reeves  ⌐1998-1999                      *
  16. *                                                                        *
  17. * This code may be freely used, as long as this header remains intact.   *
  18. *                                                                        *
  19. **************************************************************************}
  20.  
  21. {
  22.   This object just does basic reading and storage of the command line. It is up to the 
  23.   developer to write the code that responds to the values.
  24.  
  25.   Params checked for:
  26.     The Base type checks for the following:
  27.  
  28.       /AL - AutoLogin
  29.       /H  - Display help screen (only applicable to console applications.)
  30.       /M  - Set Monitor on - Use this in code to set 'debug' labels visible at runtime.
  31.       /NS - No Splash Screen - Use this to remove a splash screne while debugging startup code.
  32.       /SQL- Test for this to write an SQL statement to file, prior to execution
  33.  
  34.     The InterBase type checks for these params:
  35.  
  36.       /B  - Buffers
  37.       /C  - Character Set
  38.         /D  - Database name
  39.       /N  - Network Protocol
  40.         /P  - Password
  41.       /R  - SQL Role
  42.       /S  - Server
  43.       /U  - Username
  44.  
  45.     Usage:
  46.         Declare a variable of the appropriate type and read the properties.
  47.         Params that are qualifed with string should be separated from the param.
  48.     ie: /d c:\data\mydatabase.gdb
  49.     Do not use quotes around the string.
  50.  
  51.     Interbase Network Protocols:
  52.         There is an undocumented command line switch for WISQL that uses numbers
  53.       to specify the network protocol. This object follows the convention. See the code
  54.     for GetIBDatabase for more details.
  55.  
  56.       If a server is specified a connection protocol must be specified, otherwise a local
  57.       connection will be attempted and the server name ignored.
  58.  
  59. }
  60.  
  61. interface
  62.  
  63. uses
  64.     Windows
  65.   , SysUtils
  66.   ;
  67.  
  68. type
  69.   TStartUpParams = class(TObject)
  70.   private
  71.         FAppName:        String;        {Application name}
  72.         FAppDir:        String;        {Directory the application is running in}
  73.     FAutoLogin: Boolean;
  74.     FConfirmRecDelete: Boolean;
  75.     FConfirmAppExit: Boolean;
  76.     FMonitorOn:    Boolean;
  77.     FSaveSQL:        Boolean;
  78.     FSplashOn:    Boolean;
  79.     FToolBarTop: Integer;
  80.     FToolBarLeft: Integer;
  81.     FUserNetId: String;
  82.     FUseAppName: Boolean;
  83.     FWinDir: String;
  84.     FDisplayHelp: Boolean;
  85.   public
  86.     Constructor Create; virtual;
  87.       destructor    Destroy; override;
  88.     class function GetNetUserName: String;
  89.     class function GetEnvVar(EnvVar: String): String;
  90.   published
  91.     Property AppName: String read FAppName write FAppName;        {Application name}
  92.     Property AppDir: String read FAppDir write FAppDir;        {Directory the application is running in}
  93.     Property AutoLogin: Boolean read FAutoLogin;
  94.     property ConfirmRecDelete: Boolean read FConfirmRecDelete write FConfirmRecDelete;
  95.     property ConfirmAppExit: Boolean read FConfirmAppExit write FConfirmAppExit;
  96.     property DisplayHelp: Boolean read FDisplayHelp write FDisplayHelp;
  97.     Property MonitorOn:    Boolean read FMonitorOn;
  98.     Property SaveSQL:        Boolean read FSaveSQL write FSaveSQL;
  99.     Property SplashOn:    Boolean read FSplashOn default True;
  100.         property ToolBarTop: Integer read fToolBarTop write fToolBarTop;
  101.         property ToolBarLeft: Integer read fToolBarLeft write fToolBarLeft;
  102.     property UseAppName: Boolean read FUseAppName write FUseAppName default True;
  103.         property UserNetId: String read FUserNetId write FUserNetId;
  104.     property WinDir:    String read FWinDir write FWinDir;
  105.     end;
  106.  
  107.   TIBStartUpParams = class(TStartUpParams)
  108.   private
  109.     FIBDatabase: String;
  110.     FIBPassword: String;
  111.     FIBProtocol: Integer;
  112.       FIBServer: String;
  113.     FIBUsername: String;
  114.     FIBRole: String;
  115.     FIBCharSet: String;
  116.     FIBBuffers: Integer;
  117.  
  118.     Function GetProtocol: String;     //protocol as a string
  119.     Procedure SetProtocol(AProtocol: String);
  120.   protected
  121.   public
  122.     Constructor Create; override;
  123.       destructor    Destroy; override;
  124.       Function GetIBDatabase: String; //returns server, protocol and database
  125.   published
  126.     Property IBBuffers: Integer read FIBBuffers write FIBBuffers;
  127.     Property IBCharSet: String read FIBCharSet write FIBCharSet;
  128.     Property IBDatabase: String read GetIBDatabase;
  129.     Property IBDatabaseName: String read FIBDatabase write FIBDatabase;
  130.     Property IBPassword: String read FIBPassword write FIBPassword;
  131.     Property IBProtocol: String read GetProtocol write SetProtocol;
  132.     Property IBRole: String read FIBRole write FIBRole;
  133.         Property IBServer: String read FIBServer write FIBServer;
  134.     Property IBUsername: String read FIBUsername write FIBUsername ;
  135.     end;
  136.  
  137.  
  138. //For InterBase applications there is no point in declaring a variable of
  139. //type TStartupParams.   
  140. var
  141.     IBStartupParams: TIBStartUpParams;
  142.  
  143.  
  144. implementation
  145.  
  146. Constructor TStartUpParams.create;
  147. var
  148.     i: integer;
  149.  
  150. begin
  151.  
  152. inherited create;
  153.  
  154. FAppName:=ChangeFileExt(extractFileName(paramstr(0)),'');
  155. FAppDir:=extractFilePath(paramstr(0));
  156.  
  157. try
  158.     FUserNetId:=getNetUserName;
  159. except
  160.     FUserNetId:='NO_NET_ID';
  161. end;
  162.  
  163. {SplashOn} {if set false then don't show the splash screen}
  164. FSplashOn:=True;
  165. for i:=0 to paramcount do
  166.   if ((uppercase(paramstr(i))='-NS') or
  167.     (uppercase(paramstr(i))='/NS'))  then begin
  168.       FSplashOn:=False;
  169.       break;
  170.       end;
  171.  
  172. {AutoLogin} {if true then connect to db without login prompt}
  173. for i:=0 to paramcount do
  174.   if ((uppercase(paramstr(i))='-AL') or
  175.     (uppercase(paramstr(i))='/AL'))  then begin
  176.       FAutoLogin:=True;
  177.       break;
  178.     end;
  179.  
  180. {DisplayHelp} {if true then write help info to console (n/a to windows apps) }
  181. for i:=0 to paramcount do
  182.   if ((uppercase(paramstr(i))='-H') or
  183.     (uppercase(paramstr(i))='/H'))  then begin
  184.       FDisplayHelp:=True;
  185.       break;
  186.     end;
  187.  
  188. {MonitorOn} {if true then set some controls visible to enable monitoring}
  189. for i:=0 to paramcount do
  190.   if ((uppercase(paramstr(i))='-M') or
  191.     (uppercase(paramstr(i))='/M'))  then begin
  192.       FMonitorOn:=True;
  193.       break;
  194.     end;
  195.  
  196. {SaveSQL } {if true then save SQL statements where appropriate}
  197. for i:=0 to paramcount do
  198.   if (uppercase(paramstr(i))='-SQL') or
  199.     (uppercase(paramstr(i))='/SQL')    then begin
  200.       FSaveSQL:=True;
  201.       break;
  202.     end;
  203. end;
  204.  
  205. Destructor TStartUpParams.Destroy;
  206. begin
  207.  
  208. inherited Destroy;
  209. end;
  210.  
  211. class function TStartUpParams.GetNetUserName: String;
  212. var
  213.   Len: DWORD;
  214.   Name: array[0..255] of Char;
  215. begin
  216.   Len := SizeOf(Name);
  217.   WNetGetUser({$ifdef Win32}nil, {$endif}Name, Len);
  218.   Result := StrPas(Name);
  219. end;
  220.  
  221. class function TStartUpParams.GetEnvVar(EnvVar: String): String;
  222. var
  223.    tempstr  :  array[0..255] of char;
  224. begin
  225. FillChar(tempstr,255,#0);
  226. GetEnvironmentVariable(PChar(EnvVar),tempstr,255);
  227. result:=tempstr;
  228. end;
  229.  
  230. {TIBStartUpParams=============================================}
  231. Constructor TIBStartUpParams.Create;
  232. var
  233.     i: integer;
  234. begin
  235. inherited Create;
  236.  
  237. {IBBuffers}
  238. FIBBuffers:=0;
  239. for i:=0 to paramcount do begin
  240.   if (uppercase(paramstr(i))='-B') or
  241.       (uppercase(paramstr(i))='/B') then begin
  242.     FIBBuffers:=StrToInt(paramstr(i+1));
  243.     break;
  244.   end;
  245. end;
  246.  
  247. {IBDatabase}
  248. FIBDatabase:='';
  249. for i:=0 to paramcount do begin
  250.   if (uppercase(paramstr(i))='-D') or
  251.         (uppercase(paramstr(i))='/D')    then begin
  252.         FIBDatabase:=paramstr(i+1);
  253.       break;
  254.   end;
  255. end;
  256.  
  257. {IBPassword}
  258. FIBPassword:='';
  259. for i:=0 to paramcount do begin
  260.   if (uppercase(paramstr(i))='-P') or
  261.         (uppercase(paramstr(i))='/P')    then begin
  262.       FIBPassword:=paramstr(i+1);
  263.       break;
  264.     end;
  265.   end;
  266. //if still no password then check environment  
  267. if FIBPAssword='' then 
  268.   FIBPAssword:=GetEnvVar('ISC_PASSWORD');  
  269.  
  270. {IBServer}
  271. FIBServer:='';
  272. for i:=0 to paramcount do begin
  273.   if (uppercase(paramstr(i))='-S') or
  274.         (uppercase(paramstr(i))='/S')    then begin
  275.       FIBServer:=paramstr(i+1);
  276.       break;
  277.         end;
  278.   end;
  279.  
  280. {IBUsername}
  281. FIBUserName:='';
  282. for i:=0 to paramcount do begin
  283.   if (uppercase(paramstr(i))='-U') or
  284.         (uppercase(paramstr(i))='/U')    then begin
  285.       FIBUsername:=paramstr(i+1);
  286.       break;
  287.   end;
  288. end;
  289. //if still no username then check environment  
  290. if FIBUsername='' then 
  291.   FIBUsername:=GetEnvVar('ISC_USER');  
  292.  
  293.  
  294. {IBProtocol}
  295. FIBProtocol:=3; //default to local connection
  296. for i:=0 to paramcount do begin
  297.   if (uppercase(paramstr(i))='-N') or
  298.             (uppercase(paramstr(i))='/N') then begin
  299.       FIBProtocol:=StrToInt(paramstr(i+1));
  300.       break;
  301.     end;
  302.   end;
  303.  
  304. {IBRole}
  305. FIBRole:='';
  306. for i:=0 to paramcount do begin
  307.   if (uppercase(paramstr(i))='-R') or
  308.         (uppercase(paramstr(i))='/R')    then begin
  309.       FIBRole:=paramstr(i+1);
  310.       break;
  311.   end;
  312. end;
  313.  
  314. {IBCharSet}
  315. FIBCharSet:='';  
  316. for i:=0 to paramcount do begin
  317.   if (uppercase(paramstr(i))='-C') or
  318.         (uppercase(paramstr(i))='/C')    then begin
  319.       FIBCharSet:=paramstr(i+1);
  320.       break;
  321.   end;
  322. end;
  323.  
  324. end;
  325.  
  326. Destructor TIBStartUpParams.Destroy;
  327. begin
  328.   //Nothing to do  
  329.   
  330.     inherited Destroy;
  331. end;
  332.  
  333. Function TIBStartUpParams.GetIBDatabase: string;
  334. begin
  335.     case FIBProtocol of
  336.         0    :    result:='\\'+FIBServer+'\'+FIBDatabase;    //netbeui;
  337.       1    :    result:=FIBServer+'@'+FIBDatabase;            //ipx/spx - not really supported
  338.       2    :    result:=FIBServer+':'+FIBDatabase;            // tcp/ip
  339.     else
  340.         result:=FIBDatabase;
  341.     end;
  342. end;
  343.  
  344. Function TIBStartUpParams.GetProtocol: string;
  345. begin
  346.     case FIBProtocol of
  347.         0    :    result:='netbeui';
  348.       1    :    result:='ipx/spx';
  349.       2    :    result:='tcp/ip';
  350.     else
  351.         result:='local';
  352.     end;
  353. end;
  354.  
  355. Procedure TIBStartUpParams.SetProtocol(AProtocol: String);
  356. begin
  357. if uppercase(AProtocol)='NETBEUI' then
  358.     FIBProtocol:=0
  359. else
  360.     if uppercase(AProtocol)='IPX/SPX' then
  361.         FIBProtocol:=1
  362.   else
  363.         if uppercase(AProtocol)='TCP/IP' then
  364.             FIBProtocol:=2
  365.     else
  366.           FIBProtocol:=3;
  367.  
  368. end;
  369.  
  370. initialization
  371.  
  372. IBStartUpParams:=TIBStartUpParams.create;
  373.  
  374. finalization
  375. if assigned(IBStartUpParams) then
  376.   IBStartUpParams.free;
  377.   
  378.  
  379. end.
  380.