funcsex.pas

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

//          1.0 on failure
//
function UTC2Local(utc_time: TDateTime): TDateTime;
var SystemTime, LocalTime: TSystemTime;
    TimeZoneInfo: TTimeZoneInformation;
    r, hours: DWORD;
    ahead: Boolean;
begin
     // First, try the Windows NT supported method
     DateTimeToSystemTime(utc_time, SystemTime);
     if SystemTimeToTzSpecificLocalTime(nil, SystemTime, LocalTime) then
        // Success
        Result:=SystemTimeToDateTime(LocalTime)
     else begin
        // Failed, probably because we are using Windows 95/98
        r:=GetTimeZoneInformation(TimeZoneInfo);
        if r<>$0FFFFFFFF then begin
           // Are we ahead or behind UTC time?
           if TimeZoneInfo.Bias < 0 then ahead:=TRUE else ahead:=FALSE;
           TimeZoneInfo.Bias:=Abs(TimeZoneInfo.Bias);

           // Work out how many hours & minutes difference
           hours:=TimeZoneInfo.Bias div 60;
           Dec(TimeZoneInfo.Bias, hours * 60);

           // Convert the UTC time to local time
           if ahead then Result:=utc_time + EncodeTime(hours, TimeZoneInfo.Bias, 0, 0)
           else Result:=utc_time - EncodeTime(hours, TimeZoneInfo.Bias, 0, 0);
        end else
           // Failed
           Result:=1.0
     end;
end;

//
// Converts a local time & date to a UTC time & date
//
// Args: local date & time to convert
//
// Returns: UTC Date & time
//          1.0 on failure
//
function Local2UTC(local_time: TDateTime): TDateTime;
var SystemTime: TSystemTime;
    TimeZoneInfo: TTimeZoneInformation;
    r, hours: DWORD;
    ahead: Boolean;
begin
     DateTimeToSystemTime(local_time, SystemTime);
     r:=GetTimeZoneInformation(TimeZoneInfo);
     if r<>$0FFFFFFFF then begin
        // Are we ahead or behind UTC time?
        if TimeZoneInfo.Bias < 0 then ahead:=TRUE else ahead:=FALSE;
        TimeZoneInfo.Bias:=Abs(TimeZoneInfo.Bias);

        // Work out how many hours & minutes difference
        hours:=TimeZoneInfo.Bias div 60;
        Dec(TimeZoneInfo.Bias, hours * 60);

        // Convert the UTC time to local time
        if ahead then Result:=local_time - EncodeTime(hours, TimeZoneInfo.Bias, 0, 0)
        else Result:=local_time + EncodeTime(hours, TimeZoneInfo.Bias, 0, 0);
     end else
        // Failed
        Result:=1.0
end;

//
// Given a date and time, return a local date & time string
//
// Args: date
//       time
//
// Returns: string version of date & time (local)
//
function UTC2LocalStr(utc_date: TDate; utc_time: TTime): String;
begin
     Result:=DateTimeToStr(UTC2Local(Int(utc_date) + Frac(utc_time))) + ' ' + TimeZone;
end;

//
// Returns the current UTC date & time
//
// This function must be used instead of the Now function to get the UTC
// time instead of the current time-zone modified date & time.
//
// Returns: UTC date & time
//
function UTCNow: TDateTime;
var SystemTime: TSystemTime;
begin
     GetSystemTime(SystemTime);
     Result := SystemTimeToDateTime(SystemTime);
end;

//
// Returns the current UTC date
//
// This function must be used instead of the Date function to get the UTC
// date instead of the current time-zone modified date.
//
// Returns: UTC date
//
function UTCDate: TDateTime;
var SystemTime: TSystemTime;
begin
     GetSystemTime(SystemTime);
     Result := Int(SystemTimeToDateTime(SystemTime));
end;

//
// Returns the current UTC time
//
// This function must be used instead of the Time function to get the UTC
// time instead of the current time-zone modified time.
//
// Returns: UTC date
//
function UTCTime: TDateTime;
var SystemTime: TSystemTime;
begin
     GetSystemTime(SystemTime);
     Result := Frac(SystemTimeToDateTime(SystemTime));
end;

//
// Encrypt string that be decrypted later
//
// Args: string to encrypt (cannot be greater than 128 bytes in length)
//       encryption key (must use same key to decrypt)
//
// To decrypt a string use the function Decrypt
//
function Encrypt(const S: String; encryption_key: Integer=ENC_KEY): String;
var I: byte;
    r, hexstr: string;
    key: WORD;
begin
  // Empty string?
  if S='' then begin
     Result:='';
     Exit;
  end;

  // Encrypt
  key:=encryption_key;
  SetLength(Result, Length(S));
  for I := 1 to Length(S) do begin
    Result[I] := char(byte(S[I]) xor (key shr 8));
    key := (byte(Result[I]) + key) * C1 + C2;
  end;

  // Convert to a safe string representation
  SetLength(hexstr, Length(S) * 2);
  SetLength(r, 3);
  r[3]:=Chr(0);
  for i:=1 to Length(S) do begin
      try
        r:=Format('%.2x', [Byte(Result[i])]);
      except
        // Error encrypting string
        r:='00'+Chr(0);
      end;
      StrLCopy(@hexstr[1+((i-1) * 2)], @r[1], 2);
  end;
  Result:=hexstr;
end;

// Decrypt string, see Encrypt function
//
// Args: string to decrypt
//       key to use to decrypt
//
// String cannot be greater than 128 bytes in length
function Decrypt(const S: String; decryption_key: Integer=ENC_KEY): String;
var I, i2: byte;
    r, lit: string;
    len: integer;
    key: WORD;
begin
  // Empty string?
  if S='' then begin
     Result:='';
     Exit;
  end;

  // Convert from hex string representation to literal string
  key:=decryption_key;
  len:=Length(S) div 2;
  SetLength(lit, len);
  SetLength(r, 3);
  r[2]:=Chr(0);
  i:=1;
  i2:=1;
  while i<=Length(s) do begin
     StrLCopy(@r[1], @s[i], 2);
     try
       lit[i2]:=Chr(StrToInt('$'+r));
     except
       // Error - the decrypt will give the wrong results, but
       // the encrypt string was wrong anyway!
       lit[i2]:=' ';
     end;

     // Next block
     Inc(i, 2);
     Inc(i2, 1);
  end;

  // Decrypt the string in 'lit'
  SetLength(Result, len);
  for I := 1 to len do begin
    Result[I] := char(byte(lit[I]) xor (key shr 8));
    key := (byte(lit[I]) + key) * C1 + C2;
  end;
end;

//
// Create a file from an OleVariant variable
//
// Args: file contents (the OLE Variant)
//       file to write to (filename)
//       if append_to is TRUE the contents is appended to any existing file
//
// Returns TRUE on success
//
function VariantToFile(thefile: OleVariant; fname:string; append_to: Boolean=FALSE): boolean;
var F: TFileStream;
    fsize: Integer;
    Data: PChar;
begin
     // Assume failure
     Result:=FALSE;
     F:=nil;

     // Get size of variant - this is how many bytes we will dump into the file
     try
        fsize:=(VarArrayHighBound(TheFile, 1) - VarArrayLowBound(TheFile, 1)) + 1;
        if fsize<0 then Exit;
     except
        Exit;
     end;

     // Open file for writing
     if append_to then begin
        try
           F:=TFileStream.Create(fname, fmOpenReadWrite + fmShareExclusive);
           F.Seek(0, soFromEnd);
        except
           // File does not exist - we'll create it later
           if F<>nil then Exit;
        end;
     end;

     // Create file - if not already open
     if F=nil then begin
        try
           F:=TFileStream.Create(fname, fmCreate);
        except
           // Failed to create file
           Exit;
        end;
     end;

     // Write to file
     try
        try
           Data := VarArrayLock(TheFile);
           F.WriteBuffer(Data^, fsize);
           Result:=TRUE;
        finally
           VarArrayUnlock(TheFile);
           F.Free;
        end;
     except
        // Failed - ignore
     end;
end;

//
// Create an OleVariant variable from a file
//
// Args: file to read from (filename)
//
// Returns file contents, or Unassigned on error
//
function FileToVariant(fname:string): OleVariant;
var F: TFileStream;
    Data: PChar;
begin
     // Assume failure
     Result:=Unassigned;

     // Open file (read-only)
     try
        // Can open read-only files
        F:=TFileStream.Create(fname, fmOpenRead + fmShareDenyNone);
     except
        Exit;
     end;

     // Read file
     Result := VarArrayCreate([0, F.Size - 1], varByte);
     try
        Data := VarArrayLock(Result);
     except
        VarArrayUnlock(Result);
        F.Free;
        Result:=Unassigned;
        Exit;
     end;
     try
        F.ReadBuffer(Data^, F.Size);
     except
        VarArrayUnlock(Result);
        F.Free;
        Result:=Unassigned;
        Exit;
     end;

     // Finished reading file
     VarArrayUnlock(Result);
     F.Free;
end;

//
// Return a random string of characters that is not safe to be displayed
// i.e. it is not ASCII (8-bit, ranging from 1 to 255 inclusive)
//
// Args: length of string to produce
//
// Returns: random string of characters (values range from 1..255)
//
function UnPrintableRandomString(len: Integer): WideString;
var i:integer;
begin
     // Create string
     Result:='';
     for i:=1 to len do Result:=Result + Chr(1+Random(254));
end;

//
// Return a random string of characters that is safe to be displayed
// i.e. it is ASCII (only numbers and letters are used)
//
// Args: length of string to produce
//
// Returns: random string of characters (a..z, A..Z, 0..9)
//
function PrintableRandomString(len: Integer): String;
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;