utils.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

begin
       // Create string
     Result:='';
     for i:=1 to len do
       case Integer(Random(3000)) of
         0..999:  Result:=Result + Chr(Ord('0')+Random(9));
         1000..1999: Result:=Result + Chr(Ord('a')+Random(25));
         2000..3000: Result:=Result + Chr(Ord('A')+Random(25));
       end;
end;

// Returns network adaptor name (12 characters)
// or empty string ('') on error/failure
function GetAdapterName: string;
type TAdapter = packed record
	Adapt : TAdapterStatus;
	NameBuff : TNameBuffer;
     end;
var
  ncb : TNCB;
  Adapter : TAdapter;
begin
  try
    FillChar(ncb, sizeof(ncb), 0);
    ncb.ncb_command := Char(NCBRESET);
    ncb.ncb_lana_num := Char(0);
    NetBios(@ncb);

    FillChar(ncb, sizeof(ncb), 0);
    ncb.ncb_command := Char(NCBASTAT);
    ncb.ncb_lana_num := Char(0);
    StrCopy(ncb.ncb_callname, '*               ');
    ncb.ncb_buffer := @Adapter;
    ncb.ncb_length := sizeof(Adapter);
    NetBios(@ncb);

    SetLength(Result, 12);
    with Adapter.Adapt do begin
      Result := IntToHex(Integer(adapter_address[0]), 2)+
        IntToHex(Integer(adapter_address[1]), 2)+
        IntToHex(Integer(adapter_address[2]), 2)+
        IntToHex(Integer(adapter_address[3]), 2)+
        IntToHex(Integer(adapter_address[4]), 2)+
        IntToHex(Integer(adapter_address[5]), 2);
    end;
  except
    Result:='';
  end;
end;

//
// Returns the area of the display that the applicatiom can use
// i.e. screen area less the taskbar (which may or may not be displayed,
//      and also may be at any edge of the screen!)
//
// Returns the area that can be used: Top, Left, Bottom, Right (therefore
// the width is Right - Left, and height:=Bottom - Top)
//
// This function will work on Windows NT 3.51 also (it will simply return
// the screen settings by default)
//
function GetWorkArea: TRect;
var r:boolean;
begin
    try
      r:=SystemParametersInfo(SPI_GETWORKAREA, 0, Pointer(@Result), 0);
    except
      r:=false;
    end;

    if not r then begin
       // Failed - this may be Windows NT 3.51. Use default screen settings
       Result.Top:=0;
       Result.Left:=0;
       Result.Bottom:=Screen.Height;
       Result.Right:=Screen.Width;
    end;
end;

//
// Returns TRUE if application is running on Windows NT (actually, it returns
// TRUE if the operating system is definitely not Windows 95/98/3.1, which
// means it will return TRUE for future operating systems)
//
{$IFNDEF WIN32}
const WF_WINNT = $4000;
{$ENDIF}
function IsNT : bool;
{$IFDEF WIN32}
var osv:TOSVERSIONINFO;
{$ENDIF}
begin
{$IFDEF WIN32}
     osv.dwOSVersionInfoSize:=SizeOf(TOSVERSIONINFO);
     GetVersionEx(osv);
     if (osv.dwPlatformId=VER_PLATFORM_WIN32s) or (osv.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) then
        // Windows 95/98 or Win3.1 with Win32S
        result:=false
     else
        // Must be either VER_PLATFORM_WIN32_NT or a new operating system
        result:=true;
{$ELSE}
     if ((GetWinFlags and WF_WINNT) = WF_WINNT ) then result:=true
     else result:=false;
{$ENDIF}
end;

// Run a program (does not wait for execution to complete)
// Pass Visibility as SW_SHOWDEFAULT
function WinExec32(FileName:String; Visibility : integer):integer;
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
begin
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  Result:=0;
  if not CreateProcess(nil,
    zAppName,                      { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    false,                         { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    nil,                           { pointer to current directory name }
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }
end;

// Run a program and wait for it to finish executing
// Pass Visibility as SW_SHOWDEFAULT
function WinExecAndWait32(FileName:String; Visibility : integer):Integer;
var
  zAppName:array[0..512] of char;
  zCurDir:array[0..255] of char;
  WorkDir:String;
  StartupInfo:TStartupInfo;
  ProcessInfo:TProcessInformation;
  ExitCode: DWORD;
begin
  StrPCopy(zAppName,FileName);
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);

  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                      { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    false,                         { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    nil,                           { pointer to current directory name }
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }

  else begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
    Result:=ExitCode;
  end;
end;

//
// Delete ALL the files in a directory, but not the directory itself
// To remove the directory itself simply call RemoveDir(dir);
//
procedure EmptyDirectory(dir: string);
var SearchRec: TSearchRec;
begin
    // Just to make sure we don't wipe the root directory
    if Length(dir) < 4 then Exit;

    // Delete all files in directory
    if SysUtils.FindFirst(dir+'\*.*', faAnyFile - faDirectory, SearchRec)=0 then begin
       repeat SysUtils.DeleteFile(dir+'\'+SearchRec.Name)
       until SysUtils.FindNext(SearchRec)<>0;
       SysUtils.FindClose(SearchRec);
    end;
end;


//
// Register ActiveX
// See DCOM_Register
//
function RegisterAxLib(const filename: String): Integer;
var RegProc: TRegProc;
    LibHandle: THandle;
begin
     LibHandle := LoadLibrary(PChar(FileName));
     if LibHandle = 0 then begin
        Result:= -1;
        Exit;
     end;
     try
        @RegProc := GetProcAddress(LibHandle, ProcName[raReg]);
        if @RegProc = Nil then begin
           Result:= -2;
           Exit;
        end;
        if RegProc <> 0 then begin
           Result:= -3;
           Exit;
        end;
     finally
        FreeLibrary(LibHandle);
     end;

     // Done
     Result:=0;
end;

//
// Register a type-library
// See DCOM_Register
//
function RegisterTLB(filename: String): Integer;
var WFileName, DocName: WideString;
    TypeLib: ITypeLib;
    LibAttr: PTLibAttr;
    DirBuffer: array[0..MAX_PATH] of char;
begin
     if ExtractFilePath(FileName) = '' then begin
       GetCurrentDirectory(SizeOf(DirBuffer), DirBuffer);
       FileName := '\' + FileName;
       FileName := DirBuffer + FileName;
     end;
     if not FileExists(FileName) then begin
        Result:= -1;
        Exit;
     end;

     WFileName := FileName;
     OleCheck(LoadTypeLib(PWideChar(WFileName), TypeLib));
     OleCheck(TypeLib.GetLibAttr(LibAttr));
     try
        OleCheck(TypeLib.GetDocumentation(-1, nil, nil, nil, @DocName));
        DocName := ExtractFilePath(DocName);
        OleCheck(RegisterTypeLib(TypeLib, PWideChar(WFileName), PWideChar(DocName)));
     finally
        TypeLib.ReleaseTLibAttr(LibAttr);
     end;

     // Done
     Result:=0;
end;

//
// Register an executable
// See DCOM_Register
//
function RegisterEXE(const filename: String): Integer;
var SI: TStartupInfo;
    PI: TProcessInformation;
begin
     FillChar(SI, SizeOf(SI), 0);
     SI.cb := SizeOf(SI);
     Win32Check(CreateProcess(PChar(FileName), PChar(FileName + ExeFlags[raReg]),
       nil, nil, True, 0, nil, nil, SI, PI));
     CloseHandle(PI.hThread);
     CloseHandle(PI.hProcess);
     Result:=0;
end;

//
// Register a file
//
// Args: file to register, e.g. c:\abc.tlb, c:\dcomserver.exe, etc.
//
// Returns: 0 on success
//
function DCOM_Register(filename: String): Integer;
var FileExt: String;
begin
     // Get file type so we know what to register
     FileExt := ExtractFileExt(FileName);
     if FileExt = '' then begin
        // No extension
        Result:= -1;
        Exit;
     end;

     // Register as appropriate
     try
        if CompareText(FileExt, '.TLB') = 0 then Result:=RegisterTLB(filename)
        else if CompareText(FileExt, '.EXE') = 0 then Result:=RegisterEXE(filename)
        else Result:=RegisterAxLib(filename);
     except
        Result:=-1;
     end;
end;


procedure SaveColumn(Registry: TRegIniFile; RegKey: string; Grid: TDBGrid);
var
  i: integer;
begin
  RegKey:= RegKey+'\'+Grid.Name;
  Registry.WriteInteger(RegKey, 'columns', Grid.FieldCount);
  for i:=1 to Grid.FieldCount do
    begin
      // Save its original column position
      Registry.WriteInteger(RegKey, 'index'+IntToStr(i), Grid.Columns[i-1].Index);

      // Now save its settings
      Registry.WriteInteger(RegKey, 'alignment'+IntToStr(i), Integer(Grid.Columns[i-1].Alignment));
      //Registry.WriteInteger(RegKey, 'buttonstyle'+IntToStr(i), Integer(Grid.Columns[i-1].ButtonStyle));
      Registry.WriteString(RegKey, 'caption'+IntToStr(i), Grid.Columns[i-1].Title.Caption);
      Registry.WriteInteger(RegKey, 'colour'+IntToStr(i), Grid.Columns[i-1].Color);
      Registry.WriteString(RegKey, 'fieldname'+IntToStr(i), Grid.Columns[i-1].FieldName);
      //Registry.WriteBool(RegKey, 'readonly'+IntToStr(i), Grid.Columns[i-1].ReadOnly);
      Registry.WriteInteger(RegKey, 'width'+IntToStr(i), Grid.Columns[i-1].Width);
    end;
end;

procedure LoadColumn(Registry: TRegIniFile; RegKey: string; Grid: TDBGrid);
var
  i, actual: integer;
begin
  RegKey:= RegKey + '\' + Grid.Name;
  for i:= 1 to Registry.ReadInteger(RegKey, 'columns', 0) do
    begin
      // Get the columns original position
      actual:= Registry.ReadInteger(RegKey, 'index' + IntToStr(i), -1);
      if actual < 0 then continue;

      // Set it (except for readonly which will cause problems)
      Grid.Columns[actual].FieldName:= Registry.ReadString(RegKey, 'fieldname' + IntToStr(i), Grid.Columns[i - 1].FieldName);
      //Grid.Columns[actual].ReadOnly:= Registry.ReadBool(RegKey, 'readonly' + IntToStr(i), Grid.Columns[i - 1].ReadOnly);
      //Grid.Columns[actual].ButtonStyle:= TColumnButtonStyle(Registry.ReadInteger(RegKey, 'buttonstyle' + IntToStr(i), Integer(Grid.Columns[i - 1].ButtonStyle)));
      Grid.Columns[actual].Alignment:= TAlignment(Registry.ReadInteger(RegKey, 'alignment' + IntToStr(i), Integer(Grid.Columns[i - 1].Alignment)));
      Grid.Columns[actual].Title.Caption:= Registry.ReadString(RegKey, 'caption'+IntToStr(i), Grid.Columns[i - 1].Title.Caption);
      Grid.Columns[actual].Color:= Registry.ReadInteger(RegKey, 'colour' + IntToStr(i), Grid.Columns[i - 1].Color);
      Grid.Columns[actual].Width:= Registry.ReadInteger(RegKey, 'width' + IntToStr(i), Grid.Columns[i - 1].Width);
    end;
end;

// Save the size and position of a window, and its window state, to
// the registry. This can be later retrieved & set using GetWindowInfo
//
// The key saved in the registry is the forms name
procedure SaveWindowInfo(Form: TForm; WSKey: String);
var
  Reg: TRegIniFile;
  RegSec: string;
begin
  // Registry
  regsec:= '\Windows';//?
  Reg:= TRegIniFile.Create('');
  Reg.WriteInteger(regsec, 'State', Integer(Form.WindowState));
  if form.WindowState = wsNormal then
  begin
    Reg.WriteInteger(regsec, 'Top', Form.Top);
    Reg.WriteInteger(regsec, 'Left', Form.Left);
    Reg.WriteInteger(regsec, 'Width', Form.Width);
    Reg.WriteInteger(regsec, 'Height', Form.Height);
  end;
  Reg.Free;
end;

// Get the size and position of a window, and its window state, from
// the registry and update the actual window position, size, etc.
//
// The key saved in the registry is the forms name
//
// Window settings are saved to the registry using SaveWindowInfo
procedure LoadWindowInfo(Form: TForm; WSKey: String);
var
  Reg: TRegIniFile;
  RegSec: string;
begin
  // Registry
  Regsec:= '\Windows'; //?
  Reg:= TRegIniFile.Create('');
  Form.Top:= Reg.ReadInteger(regsec, 'Top', Form.Top);
  Form.Left:= Reg.ReadInteger(regsec, 'Left', Form.Left);
  Form.Width:= Reg.ReadInteger(regsec, 'Width', Form.Width);
  Form.Height:= Reg.ReadInteger(regsec, 'Height', Form.Height);
  Form.WindowState:= TWindowState(Reg.ReadInteger(regsec, 'State', Integer(Form.WindowState)));
  Reg.Free;
end;

//  This function will remove everything below the directory, include it's files
//  and subdirectory.
procedure EmptyDir(dir:string);
var
  SearchRec: TSearchRec;
begin
  // Just to make sure we don't wipe the root directory
  if dir = '' then Exit;
  // Delete all files and directories in the directory
  if FindFirst(dir + '\*.*', faAnyfile, SearchRec) = 0 then
     while Findnext(SearchRec) = 0 do
       if (SearchRec.Attr and faDirectory) = faDirectory then
          if (SearchRec.Name = '.') or (SearchRec.Name = '..') then
             Continue
          else EmptyDir(dir + '\' + SearchRec.Name)
          else Sysutils.DeleteFile(dir + '\' + SearchRec.Name);
       Sysutils.FindClose(SearchRec);
    RemoveDir(dir);
end;

function FindField(GridName: TDBGrid; const FieldName: String): Integer;
var
  i: Integer;
begin
  for i:= 0 to GridName.FieldCount - 1 do
    if FieldName = GridName.Columns[i].FieldName then
    begin
      Result:= i;
      Exit;
    end;

  // Temporary retune value;
  Result:= -1;
end;

end.