wpfuncs.pas

来自「详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...」· PAS 代码 · 共 1,309 行 · 第 1/3 页

//
// This unit provides miscellaneous utility functions for workshop.
//
// (c) ChiconySoftware 2001
//
// When       Who      How
// ---------  ---      -------------------------------------------------------
// 2001.5.31  century  Initial version
//
//
unit wpfuncs;

interface
uses
  Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,vafuncs,ComCtrls,registry,
  ShlObj, ShellAPI, CommCtrl,
  ExtCtrls, FileCtrl, nb30, Consts, ComObj;
const
 WM_MULTINST = WM_USER + 1234;
  //Get records from Varray
  function Get_AllRecords(olearray: Variant): TStrings;
  function Get_HighRowCol(olearray: Variant;var rHigh_row,rHigh_col:integer): Boolean;
  function Get_FieldValue(olearray: Variant;const rows,cols:integer): String;
  function Get_RowColRecords(olearray: Variant;const high_row,low_row,high_col,low_col:integer): TStrings;
  function Get_ColRecords(olearray: Variant;const col:integer): TStrings;
  function Get_RowRecords(olearray: Variant;const row:integer): TStrings;
  function ListViewAddColumns(captions: array of String; widths: array of Integer;ListView:TListView):Boolean;
  function ListViewAddRows(rows: OleVariant;ListView:TListView): Integer;
  function ListViewDeleteRow(key: String;ListView:TListView): Integer;
  procedure CopyStrToOle(const Strlist:TStrings;var StrOle: OleVariant);
  procedure SaveWindowInfo(form:TForm;name:string);
  procedure GetWindowInfo(form: TForm;name:string);
  function GetTypeToDes(const rows:OleVariant;
           TableColumns,DesColumns:integer): WideString;
  function GetDesToType(const rows:Olevariant;
   description: WideString;TableColumns,DesColumns,TypeColumns:integer): Integer;

  function GetStrWhereInt(const rows:Olevariant;
       Vint: integer;TableColumns,StrColumns,IntColumns:integer): WideString;
  function GetIntWhereStr(const rows:Olevariant;
       str: WideString;TableColumns,StrColumns,IntColumns:integer): Integer;
  function GetStrWhereStr(const rows:Olevariant;
       str: WideString;TableColumns,StrColumns,DesStrColumns:integer): String;
  function GetIntWhereInt(const rows:Olevariant;
       Vint: integer;TableColumns,IntColumns,DesIntColumns:integer): integer;
  function isBuiltInUser(username:String):Boolean;
  function isBuiltInGroup(Groupname:String):Boolean;
  function isBuiltInWorkshop(Workshop:String):Boolean;
  function GetCompName:string;
  function is_running(const ident:string; wh: longint; var h:longint):boolean;
  procedure stop_it(const ident:string; handle:Longint);
  function CoverInfo(Const recName,recOrg,recVoice,RecEmail,senName,senOrg,senVoice,senFaxNum,senEmail,szSubject,szHeader,szOther:string):OleVariant;
  function FindDir(dir:string):Longint;
  procedure LCopyFile(const FileName,DestName:TFileName);
  function GetSetupDir:string;
  function GetInitInfo(MainKey,subKey:string):string;
  function CreateUniqueID(max_length:integer): WideString;
  function RandomString(len: Integer): WideString;
  function GetAdapterName: string;
  //Get database value accord to user given
  function GetInstr(val:string;flag:integer):string;
  //Get user need accord to database
  function GetOutstr(val:string;flag:integer):string;
  function TransVal(flag:integer;val:string):String;


implementation
//
// Copy a file (this is an alternative to the Win32 CopyFile function
// Raises an exception on failures
//
const
  SInvalidDest = 'Destination %s does not exist';
  SFCantMove = 'Cannot move file %s';
procedure LCopyFile(const FileName, DestName: TFileName);
begin

end;
// Return a random string of alpha-numeric characters
function RandomString(len: Integer): WideString;
var i:integer;
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;

// Create a (hopefully) unique string value
function CreateUniqueID(max_length:integer): WideString;
var n: TDateTime;
    yr,mn,dy: word;
    hr,min,sec,msec: word;
    tmp: string;
begin
     // Date & time (10 to 17 chars)
     n:=Now;
     DecodeDate(n, yr, mn, dy);
     DecodeTime(n, hr, min, sec, msec);
     Result:=IntToStr(msec)+IntToStr(sec)+IntToStr(min)+IntToStr(hr)+IntToStr(dy)+IntToStr(mn)+IntToStr(yr);

     // Network adapter (12 chars)
     tmp:=GetAdapterName;
     if tmp='' then tmp:=RandomString(12);
     Result:=Result + tmp;

     // Random characters (4 to 10 chars)
     Result:=Result + RandomString(10);

     // 32 characters max.
     if Length(Result) > max_length then SetLength(Result, max_length);
end;

function GetCompName;
var    Name:Pchar;
    size:Cardinal;
begin
     Size:=255;
     Getmem(Name,size);
     GetComputerName(Name,size);
     Result:=String(Name);
     FreeMem(Name);
end;
//
function isBuiltInGroup(groupname:string):Boolean;
begin
 if (groupname='Users') or (groupname='System')
    //or (groupname='Administrators') or (groupname='Managers')
    then
      Result:=TRUE
  else Result:=FALSE;
end;
//
function isBuiltInWorkshop(workshop:string):Boolean;
begin
  if (workshop='Administration') or (workshop='Compliance')
     or (workshop='Configuration') or (workshop='')
     or (workshop='DocCheck') or (workshop='CSR')
     or (workshop='TSR') or (workshop='Indexing')
     or (workshop='Manager') or (workshop='Reports')
     or (workshop='Scan&Fax') or (workshop='Workflow')
  then
      Result:=TRUE
  else Result:=FALSE;

end;

//
function isBuiltInUser(username:String):Boolean;
begin
  if (strUpper(pchar(username))='Admin') or (strUpper(Pchar(username))='Manager') then
      Result:=TRUE
  else Result:=FALSE;
end;

// Get window info
procedure GetWindowInfo(form: TForm;name:string);
var Registry: TRegIniFile;
    RegSec: string;
begin
     // Registry
     regsec:='\Windows\'+name;
     Registry:=TRegIniFile.Create('');
     form.top:=Registry.ReadInteger(regsec, 'Top', form.top);
     form.left:=Registry.ReadInteger(regsec, 'Left', form.left);
     form.width:=Registry.ReadInteger(regsec, 'Width', form.width);
     form.height:=Registry.ReadInteger(regsec, 'Height', form.height);
     form.WindowState:=TWindowState(Registry.ReadInteger(regsec, 'State', Integer(form.WindowState)));
     Registry.Free;
end;
// Save window info
procedure SaveWindowInfo(form: TForm;name:string);
var Registry: TRegIniFile;
    RegSec: string;
begin
     // Registry
     regsec:='\Windows\'+name;
     Registry:=TRegIniFile.Create('');
     Registry.WriteInteger(regsec, 'State', Integer(form.WindowState));
     if form.WindowState=wsNormal then begin
        Registry.WriteInteger(regsec, 'Top', form.top);
        Registry.WriteInteger(regsec, 'Left', form.left);
        Registry.WriteInteger(regsec, 'Width', form.width);
        Registry.WriteInteger(regsec, 'Height', form.height);
     end;
     Registry.Free;
end;
//value of field
function Get_FieldValue(olearray: Variant;const rows,cols:integer): String;
var
   Records: String;
   dim1: Boolean;

begin

   // Check array
   if VarIsEmpty(olearray) then begin
        // Not an array!
       ShowMessage('Array is empty');
       Exit;
   end;

    // Get bounds of array
   if VarArrayDimCount(olearray)=1 then begin
      // One-dimensional
      dim1:=TRUE;
   end else if VarArrayDimCount(olearray)=2 then begin
        // Two-dimensional
       dim1:=FALSE;
   end else begin
        // Not an array!
        //ShowMessage('Array has invalid number of dimensions:'+IntToStr(VarArrayDimCount(olearray)));
        Exit;
   end;

   Records:='';
   if dim1 then begin
      if VarType(olearray[cols])=varNull then
          Records:=''
          else if VarType(olearray[cols])=varInteger then
                  Records:=IntToStr(olearray[cols])
          else if VarType(olearray[cols])=varDate then
                  Records:=DateTimeToStr(olearray[cols])
          else if VarType(olearray[cols])=varBoolean then begin
               if olearray[cols] then Records:='TRUE'
                   else Records:='FALSE';
                end else
                   Records:=olearray[cols];
   end else begin
       if VarType(olearray[cols, rows])=varNull then
          Records:=''
          else if VarType(olearray[cols, rows])=varInteger then
                  Records:=IntToStr(olearray[cols, rows])
          else if VarType(olearray[cols, rows])=varDate then
                  Records:=DateTimeToStr(olearray[cols, rows])
          else if VarType(olearray[cols, rows])=varBoolean then begin
               if olearray[cols, rows] then Records:='TRUE'
                   else Records:='FALSE';
                end else
                    Records:=olearray[cols, rows];
   end;

   Result:=Records;

end;


//Return Row and column
function Get_HighRowCol(olearray: Variant;var rHigh_row,rHigh_col:integer): Boolean;
var high_col, high_row: Integer;

begin


     // Check array
     if VarIsEmpty(olearray) then begin
        // Not an array!
        ShowMessage('Array is empty');
        Result:=FALSE;
        Exit;
     end;

     // Get bounds of array
     if VarArrayDimCount(olearray)=1 then begin
        // One-dimensional
        high_col:=VarArrayHighBound(olearray, 1);
        high_row:=0;

     end else if VarArrayDimCount(olearray)=2 then begin
        // Two-dimensional
        high_col:=VarArrayHighBound(olearray, 1);
        high_row:=VarArrayHighBound(olearray, 2);


     end else begin

        //ShowMessage('Array has invalid number of dimensions:'+IntToStr(VarArrayDimCount(olearray)));
        Result:=FALSE;
        Exit;
     end;

     rHigh_row:=High_row;
     rHigh_col:=High_col;
     Result:=True;

end;

//Get All records
function Get_AllRecords(olearray: Variant): TStrings;
var  high_col, low_col, high_row, low_row: Integer;
    cols, rows: Integer;
    row: String;
    dim1: Boolean;
    StringList:TStrings;
begin

    try
      StringList := TStringList.Create;
    except
      Result:=nil;
      exit;
    end;
    showmessage('1');
     // Check array
     if VarIsEmpty(olearray) then begin
        // Not an array!
        //ShowMessage('Array is empty');
        Result:=nil;
        Exit;
     end;
     showmessage('2');
     // Get bounds of array
     if VarArrayDimCount(olearray)=1 then begin
        // One-dimensional
        dim1:=TRUE;
        high_col:=VarArrayHighBound(olearray, 1);
        low_col:=VarArrayLowBound(olearray, 1);
        high_row:=0;
        low_row:=0;
       
     end else if VarArrayDimCount(olearray)=2 then begin
        // Two-dimensional
        dim1:=FALSE;
        high_col:=VarArrayHighBound(olearray, 1);
        low_col:=VarArrayLowBound(olearray, 1);
        high_row:=VarArrayHighBound(olearray, 2);
        low_row:=VarArrayLowBound(olearray, 2);

     end else begin
        // Not an array!
        //ShowMessage('Array has invalid number of dimensions:'+IntToStr(VarArrayDimCount(olearray)));
        Result:=nil;
        Exit;
     end;
     showmessage('3');
     // Copy rows into scratch pad
     for rows:=low_row to high_row do begin
         row:='';
         for cols:=low_col to high_col do begin
             if dim1 then begin
                if VarType(olearray[cols])=varNull then
                   row:=row+'NULL'
                else if VarType(olearray[cols])=varInteger then
                   row:=row+IntToStr(olearray[cols])
                else if VarType(olearray[cols])=varDate then
                   row:=row+DateTimeToStr(olearray[cols])
                else if VarType(olearray[cols])=varBoolean then begin
                   if olearray[cols] then row:=row+'TRUE'
                   else row:=row+'FALSE';
                end else
                   row:=row+'['+olearray[cols]+']';
             end else begin
                if VarType(olearray[cols, rows])=varNull then
                   row:=row+'NULL'
                else if VarType(olearray[cols, rows])=varInteger then
                   row:=row+IntToStr(olearray[cols, rows])
                else if VarType(olearray[cols, rows])=varDate then
                   row:=row+DateTimeToStr(olearray[cols, rows])
                else if VarType(olearray[cols, rows])=varBoolean then begin
                   if olearray[cols, rows] then row:=row+'TRUE'
                   else row:=row+'FALSE';
                end else
                   row:=row+'['+olearray[cols, rows]+']';
             end;
             if cols<>high_col then row:=row+', ';
         end;
         StringList.Add(Row);

     end;
     Result:=StringList;
end;

//Get row records
function Get_RowRecords(olearray: Variant;const row:integer): TStrings;
var high_col, low_col: Integer;
    cols, rows: Integer;
    records: String;
    dim1: Boolean;
    StringList:Tstrings;
begin

    try
      StringList := TStringList.Create;
    except
      Result:=nil;
      exit;
    end;
    // Check array
    if VarIsEmpty(olearray) then begin
        // Not an array!
        //ShowMessage('Array is empty');
        Result:=nil;
        Exit;
     end;