www.pudn.com > Testgsm.rar > Rs232_Api.pas

unit Rs232_Api; 
 
interface 
 
uses 
  Windows, Variants, SysUtils, Forms, pub_Funcs, Dialogs; 
 
const 
  // 设备调用正常返回码 
  DEVICE_NORMAL = 0; 
  // 超时 
  E_TIMEOUT = 999; 
  // 端口初始化失败 
  E_PORT_INIT = 998; 
  // 设备尚未初始化 
  E_DEVICE_BEFORE_INIT = 997; 
  // 无效操作 
  E_VOID_ACTION = 996; 
 
  // 打印机少纸 
  W_LOW_PAPE = 19001; 
  // 打印机缺纸 
  E_NO_PAPE = 18001; 
  // 打印机卡纸 
  E_JAM_PAPE = 18002; 
 
 
type 
  BYTES = array[1..255] of Byte; 
  TBYTES = ^BYTES; 
 
var 
  CommHandle: THandle; 
  Connected: Boolean; 
  PostEvent: THandle; 
  ReadOs: Toverlapped; 
  Receive: Boolean; 
  ReceiveData: Dword; 
  szInputBuffer: Pointer; 
  Check_ErrorSum: integer; 
  DeviceLastError: integer; 
  ResponseData: array[0..255] of Byte; 
 
function OpenCom(Port: pchar): integer; //打开串口 
 
function CloseCom(): integer; //关闭串口 
 
function ReadProcess(Timeout: integer): string; //以下是实际的读取动作,读取线程函数 
 
function SendData(strOrder: string): Boolean; //发送数据 
 
implementation 
 
function OpenCom(Port: pchar): integer; 
var 
  CommTimeOut: TCOMMTIMEOUTS; 
  DCB: TDCB; 
  ComStr: string; 
begin 
  //发送消息的句柄 
  PostEvent := CreateEvent(nil, True, True, nil); 
  if PostEvent = null then begin 
    DeviceLastError := E_PORT_INIT; 
    Result := -1; 
    Exit; 
  end; 
 
  //Overlapped Read建立句柄 
  ReadOs.hEvent := CreateEvent(nil, True, FALSE, nil); 
  if ReadOs.hEvent = null then begin 
    //MessageBox(0, 'CreateEvent Error!', 'Notice', MB_OK); 
    DeviceLastError := E_PORT_INIT; 
    CloseHandle(PostEvent); 
    Result := -1; 
    Exit; 
  end; 
 
  //建立串口句柄 
  CommHandle := CreateFile(Port, GENERIC_WRITE or GENERIC_READ, 
    0, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED or FILE_ATTRIBUTE_NORMAL, 0); 
 
  if CommHandle = INVALID_HANDLE_VALUE then begin 
    CloseHandle(PostEvent); 
    CloseHandle(ReadOs.hEvent); 
    DeviceLastError := E_PORT_INIT; 
    Result := -1; 
    Exit; 
  end; 
 
  //设置超时 
  CommTimeOut.ReadIntervalTimeout := MAXDWORD; 
  CommTimeOut.ReadTotalTimeoutMultiplier := 0; 
  CommTimeOut.ReadTotalTimeoutConstant := 0; 
  SetCommTimeouts(CommHandle, CommTimeOut); 
 
  //设置读写缓存 
  SetupComm(CommHandle, 4096, 1024); 
 
  //对串口进行指定配置 
  GetCommState(CommHandle, DCB); 
  DCB.BaudRate := 9600; 
  DCB.ByteSize := 8; 
  DCB.Parity := 0; ; 
  DCB.StopBits := 0; 
  Connected := SetCommState(CommHandle, DCB); 
 
  //关系串口的读事件 
  if (not SetCommMask(CommHandle, EV_RXCHAR)) then begin 
    DeviceLastError := E_PORT_INIT; 
    Result := -1; 
    Exit; 
  end; 
 
  if (Connected) then begin 
    Connected := True; 
    Result := 0; 
  end 
  else begin 
    CloseHandle(CommHandle); 
    Result := -1; 
  end; 
end; 
 
function CloseCom(): integer; 
begin 
  if CommHandle <> INVALID_HANDLE_VALUE then begin 
    CloseHandle(CommHandle); 
    CommHandle := INVALID_HANDLE_VALUE; 
  end; 
  Result := 0; 
end; 
 
//以下是实际的读取动作,读取线程函数 
 
function ReadProcess(Timeout: integer): string; 
var 
  CommState: ComStat; 
  dwNumberOfBytesRead: Dword; 
  ErrorFlag: Dword; 
  InputBuffer: Pointer; //array[0..1024] of Char;   此处改用指针的方式，便于后续16制显示 jtp 
  lpszPostedBytes: LPSTR; 
 
  _Buffer: TBYTES; 
  _ByteStr: AnsiString; 
  tmpStr: string; 
  temp: string; 
 
  j, i: integer; 
  EndTime: Dword; 
begin 
 
  if CommHandle = INVALID_HANDLE_VALUE then begin 
    DeviceLastError := E_DEVICE_BEFORE_INIT; 
    Result := ''; 
    Exit; 
  end; 
 
  EndTime := GetTickCount + Timeout; 
  while GetTickCount < EndTime do begin 
    Application.ProcessMessages; 
    ClearCommError(CommHandle, ErrorFlag, @CommState); 
    //if CommState.cbInQue > 0 then break; 
  end; 
  if not ClearCommError(CommHandle, ErrorFlag, @CommState) then begin 
    DeviceLastError := E_DEVICE_BEFORE_INIT; 
    Result := ''; 
    PurgeComm(CommHandle, Purge_Rxabort or Purge_Rxclear); 
    Exit; 
  end; 
 
 
 
  if CommState.cbInQue > 0 then begin 
    GetMem(InputBuffer, CommState.cbInQue + 1); 
    if (not ReadFile(CommHandle, InputBuffer^, CommState.cbInQue, 
      dwNumberOfBytesRead, @ReadOs)) then begin 
      ErrorFlag := GetLastError(); 
      if (ErrorFlag <> 0) and (ErrorFlag <> ERROR_IO_PENDING) then begin 
        DeviceLastError := E_PORT_INIT; 
        Result := ''; 
        Receive := FALSE; 
        CloseHandle(ReadOs.hEvent); 
        CloseHandle(PostEvent); 
        CloseHandle(CommHandle); 
        Exit; 
      end 
      else begin 
        WaitForSingleObject(CommHandle, INFINITE); // 等待操作完成 
        GetOverLappedResult(CommHandle, ReadOs, dwNumberOfBytesRead, FALSE); 
      end; 
    end; 
    if dwNumberOfBytesRead > 0 then begin 
      ReadOs.Offset := ReadOs.Offset + dwNumberOfBytesRead; 
      ReceiveData := ReadOs.Offset; 
      // 处理接收的数据 
      _Buffer := InputBuffer; 
      _ByteStr := ''; 
      j := 0; 
      for i := 1 to dwNumberOfBytesRead do begin 
        _ByteStr := _ByteStr + IntToHex(_Buffer^[i], 2); 
        ResponseData[j] := _Buffer^[i]; 
        inc(j); 
      end; 
    end 
    else begin 
      DeviceLastError := E_TIMEOUT; 
      Result := ''; 
    end; 
    FreeMem(InputBuffer); 
  end; 
  Result := _ByteStr; 
end; 
 
 
function SendData(strOrder: string): Boolean; 
var 
  strOrderByte: array[0..128] of Byte; 
  lrc: LongWord; 
  Str: TBlocka; 
  i: integer; 
  writeoverlapped: Toverlapped; 
  ByteToWrite, BytesWritten, AllBytesWritten: Dword; 
  ErrorCode, ErrorFlag: Dword; 
  CommStat: ComStat; 
begin 
 
  //Str := myHextoStr(strOrder); 
  //Str := strOrder; 
  Str := HexTobytearray(strOrder); 
  Result := True; 
  if CommHandle = INVALID_HANDLE_VALUE then begin 
    Result := FALSE; 
    DeviceLastError := E_DEVICE_BEFORE_INIT; 
    Exit; 
  end; 
  ByteToWrite := Length(strOrder) div 2; 
  try 
    //初始化一步读写结构 
    FillChar(writeoverlapped, SizeOf(writeoverlapped), 0); 
    //避免贡献资源冲突 
    writeoverlapped.hEvent := CreateEvent(nil, True, FALSE, nil); 
    //发送数据 
    if not WriteFile(CommHandle, Str, ByteToWrite, BytesWritten, @writeoverlapped) then begin 
      ErrorCode := GetLastError; 
      if ErrorCode <> 0 then begin 
        if ErrorCode = ERROR_IO_PENDING then begin 
          //StatusBar1.SimpleText := '端口忙，正在等待...'; 
 
          while not GetOverLappedResult(CommHandle, writeoverlapped, BytesWritten, True) do begin 
            ErrorCode := GetLastError; 
            if ErrorCode = ERROR_IO_PENDING then 
              continue 
            else begin 
              ClearCommError(CommHandle, ErrorFlag, @CommStat); 
              DeviceLastError := E_VOID_ACTION; 
              Result := FALSE; 
              CloseHandle(writeoverlapped.hEvent); 
              CloseHandle(CommHandle); 
              Exit; 
            end; 
          end; 
          AllBytesWritten := AllBytesWritten + BytesWritten; 
        end 
        else begin 
          ClearCommError(CommHandle, ErrorFlag, @CommStat); 
          DeviceLastError := E_VOID_ACTION; 
          Result := FALSE; 
          CloseHandle(writeoverlapped.hEvent); 
          Receive := FALSE; 
          CloseHandle(CommHandle); 
          CloseHandle(PostEvent); 
          Exit; 
        end; 
      end; 
    end; 
  finally 
    CloseHandle(writeoverlapped.hEvent); 
  end; 
end; 
 
procedure Delay(waittime: integer); 
var 
  EndTime: Dword; 
begin 
  EndTime := GetTickCount + waittime; 
  while GetTickCount < EndTime do Application.ProcessMessages; 
end; 
 
function InsertLogfile(log_str: string): Boolean; 
var 
  F: TextFile; 
  MyStr: string; 
  sss: string; 
  FileHandle: integer; 
begin 
 
  try 
    sss := FormatDateTime('yyyy-mm-dd', Now) + '.txt'; 
    if not FileExists(sss) then begin 
      FileHandle := FileCreate(sss); 
      FileClose(FileHandle); 
    end; 
    AssignFile(F, sss); 
    Append(F); 
    MyStr := FormatDateTime('yyyy-mm-dd hh:mm:ss', Now) + chr(9) + log_str; 
    Writeln(F, MyStr); 
    Flush(F); 
    CloseFile(F); 
  except 
    Result := FALSE; 
  end; 
  Result := True; 
end; 
 
end.