vautils.pas

符合DL645规约的电能表数据解析. 可直接实现远程RTU.

{***************************************************************************}
{ TMS Async32                                                               }
{ for Delphi 4.0,5.0,6.0 & C++Builder 4.0,5.0                               }
{                                                                           }
{ Copyright 1996 - 2002 by TMS Software                                     }
{ Email : [e-mail]                                              }
{ Web : http://www.tmssoftware.com                                          }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit VaUtils;

{$I VALIB.INC}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  VaConst;

const
  PS_OPEN     = 0;
  PS_CLOSE    = 1;
  PS_NOTEXIST = 2;

type
  TVaTimeEvent = record
    Ticks: dword;
    Delay: dword;
  end;


function MinInteger(A, B: Integer): Integer;

function CN(Ch: Char): Char;

function GetPortState(PortNumber: Integer): Integer;

function StrCtrl(Value: string): string;

function BitOn(Value, Bit: Integer): Boolean;
function BitOff(Value, Bit: Integer): Boolean;

procedure InitTimer(var TimeEvent: TVaTimeEvent; MsDelay: Integer);
function TimerExpired(TimeEvent: TVaTimeEvent): Boolean;
procedure SysDelay(MsDelay: Integer; Yield: Boolean);

procedure FreeObject(var Obj);

function AddPathSlash(Path: string): string;

function GetFileSize(const FileName: string): LongInt;

function CreateUniqueFileName(FileName: string): string;

implementation


function MinInteger(A, B: Integer): Integer;
begin
  Result := A;
  if Result > B then Result := B;
end;

function CN(Ch: Char): Char;
begin
//  if Ch = #0 then Ch := #32;
  Result := Ch;
end;

procedure InitTimer(var TimeEvent: TVaTimeEvent; MsDelay: Integer);
begin
  with TimeEvent do
  begin
    Ticks := GetTickCount;
    Delay := MsDelay;
  end;
end;

function TimerExpired(TimeEvent: TVaTimeEvent): Boolean;
var
  CurTicks: dword;
begin
  with TimeEvent do
  begin
    CurTicks := GetTickCount;
    if CurTicks < Ticks then
      Result := MAXDWORD - Ticks + CurTicks > Delay
    else Result := CurTicks - Ticks > Delay;
  end;
end;

procedure SysDelay(MsDelay: Integer; Yield: Boolean);
var
  ET: TVaTimeEvent;
begin
  InitTimer(ET, MsDelay);
  repeat
    if Yield then
      Application.ProcessMessages;
  until TimerExpired(ET);
end;

function GetPortState(PortNumber: Integer): Integer;
var
  DeviceHandle: THandle;
  DeviceName: String;
begin
  DeviceName := Format('COM%d', [PortNumber]);
  DeviceHandle := CreateFile(PChar(DeviceName), GENERIC_READ or GENERIC_WRITE,
    0, nil, OPEN_EXISTING, 0, 0);
  if DeviceHandle = INVALID_HANDLE_VALUE then
  begin
    if GetLastError = ERROR_FILE_NOT_FOUND then
      Result := PS_NOTEXIST
    else
      Result := PS_OPEN;
  end else
  begin
    CloseHandle(DeviceHandle);
    Result := PS_CLOSE;
  end;
end;

function BitOn(Value, Bit: Integer): Boolean;
begin
  Result := Value and Bit > 0;
end;

function BitOff(Value, Bit: Integer): Boolean;
begin
  Result := Value and Bit = 0;
end;

function StrCtrl(Value: string): string;
var
  I, ESC: Integer;
begin
  ESC := 0;
  Result := '';
  for I := 1 to Length(Value) do
  begin
    case Value[I] of
      '^': Inc(ESC);
      else
       begin
         case ESC of
           0: Result := Result + Value[I];
           1: begin
                if Value[I] in ['a'..'z', 'A'..'Z'] then
                  Result := Result + chr(ord(Upcase(Value[I]))-64)
                else Result := Result + '^' + Value[I];
                ESC := 0;
              end;
         end;
       end;
    end;
  end;
end;

procedure FreeObject(var Obj);
var
  P: TObject;
begin
  P := TObject(Obj);
  TObject(Obj) := nil;
  if P <> nil then P.Free;
end;

function AddPathSlash(Path: string): string;
begin
  if (Path <> '') and (Path[Length(Path)] <> '\') then
    Path := Path + '\';
  Result := Path;
end;

function GetFileSize(const FileName: string): LongInt;
var
  SearchRec: TSearchRec;
begin
  try
    if FindFirst(ExpandFileName(FileName), faAnyFile, SearchRec) = 0 then
      Result := SearchRec.Size
    else Result := -1;
  finally
    SysUtils.FindClose(SearchRec);
  end;
end;

function CreateUniqueFileName(FileName: string): string;
var
  Path, Name, Ext, Temp: string;
  I, P: Integer;
begin
  Path := ExtractFilePath(FileName);
  Ext := ExtractFileExt(FileName);
  Name := ExtractFileName(FileName);

  P := Pos(Ext, Name);
  if P > 0 then Delete(Name, P, Length(Ext));

  I := 0;
  Temp := AddPathSlash(Path) + Name;
  while FileExists(Temp + Ext) do
  begin
    Inc(I);
    Temp := Path + Name + '-' + IntToStr(I);
  end;
  Result := Temp + Ext;
end;




end.