include.pas

PC机控制系统程序

{
=====================================================================
* 软件名称：PC与数控机床通信程序
* 单元名称：资源单元
* 单元作者：彭为 ([e-mail])
* 备    注：用到了线程进行发送
* 开发平台：PWin2000 SERVER + Delphi 7.0
* 兼容测试：PWin9X/2000/XP + Delphi 6/7
* 采用控件：Raize 3.12 ,SPCOMM
* 修改记录：V1.0  by pengwei
=====================================================================
}
unit Include;

interface

uses SysUtils, Classes, Windows, Messages, Forms, ShellAPI, Dialogs, WinSock;

resourcestring
  //字符串资源
  sCopyright = 'CopyRight 湖南师范大学工学院 2004';
  sMainCaption = '数控机床通讯程序-单机版';
  sExportCaption = '发送数据至数控机床';
  sImportCaption = '从数控机床接收数据';
  sFileNewCaption = '导入文件至通信服务器';
  sFileSaveasCaption = '导出文件生成磁盘备份';
  sConfigCaption = '系统配置';
  sFileInfocaption = '文件相关属性查看修改';
  sKey = '连接的设备编号';
  sValue = '设备名称';

  sTitleAsk = '询问';
  sTitleInfo = '信息';
  sTitleErr = '错误';

  sOpenDataError = '打开数据库错误，请检查当前目录是否有server.Mdb文件' + chr(13)
    + '点击确定退出系统';
  sIsStopService =
    '停止服务将导致用户无法使用客户端上传数控命令文件，请选择是否停止？';
  sInfoClose = '关闭服务器将导致用户无法使用数控机床通讯程序，您确认吗？';
  sNotFile = '数据文件不存在,请检查！';
  sFileEmpty = '文件内容是空的';
  sBreak = '正在接收数据，是否中断这一过程';
  sNotFileName = '您没有选择导入的文件名，请填入要导入的文件路径信息';
  sNotSaveasfile = '您没有选择导出的文件名，请填入要导出的文件路径信息';
  sDeleteFile = '注意：本操作将把该程序所有信息全部删除，且无法恢复' + Chr(13) +
    '建议您做好备份工作，用【导出文件】功能导出该程序，' + chr(13) +
    '需要时再用【导入文件】功能恢复。' +
    Chr(13) + '请确认是否删除？';

  sErrReceive1 = '串口接收数据出现错误';
const
  MaxChannels = 20;
  MaxFilelens = 1024;

  Timeout = 15; //10秒为超时时间
  Debug = True;

function ComPortAvailable(Port: PChar): Boolean;
function Confirm(prompt: string): boolean;
procedure ShowMsg(Msg: string);
procedure WinAbout(const AppName, Stuff: string);
function GetLocalIP: string;
//20030915 Pengwei 文件GUID创建函数  从ole32.dll引出
function CoCreateGuid(out guid: TGUID): HResult; stdcall; external 'ole32.dll';
function StringFromCLSID(const clsid: TGUID; out psz: PWideChar): HResult;
stdcall; external 'ole32.dll';
function CLSIDFromString(psz: PWideChar; out clsid: TGUID): HResult; stdcall;
external 'ole32.dll';
procedure CoTaskMemFree(pv: Pointer); stdcall; external 'ole32.dll';
//以下是自定义函数，用于转换
function GUIDToString(const ClassID: TGUID): string;
function StringToGUID(const StrClassID: string): TGUID;
//测试是否有文件尾，是否符合发送规范
function TestEOF(const Content: string): boolean;

implementation

function ComPortAvailable(Port: PChar): Boolean;
var
  DeviceName: array[0..80] of Char;
  ComFile: THandle;
begin
  StrPCopy(DeviceName, Port);

  ComFile := CreateFile(DeviceName, GENERIC_READ or GENERIC_WRITE, 0, nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL, 0);

  Result := ComFile <> INVALID_HANDLE_VALUE;
  CloseHandle(ComFile);
end;

function Confirm(prompt: string): boolean;
begin
  result := MessageBox(application.handle,
    pchar(prompt),
    '请确认', mb_ICONQuestion + mb_YesNo) = idYes;
end;

procedure ShowMsg(Msg: string);
begin
  MessageBox(application.handle,
    pchar(Msg),
    pchar(Application.title),
    mb_ICONInformation);
end;

procedure WinAbout(const AppName, Stuff: string);
var
{$IFNDEF WIN32}
  szApp, szStuff: array[0..255] of Char;
{$ENDIF}
  Wnd: HWnd;
  Icon: HIcon;
begin
  if Application.MainForm <> nil then
    Wnd := Application.MainForm.Handle
  else
    Wnd := 0;
  Icon := Application.Icon.Handle;
  if Icon = 0 then
    Icon := LoadIcon(0, IDI_APPLICATION);
{$IFDEF WIN32}
  ShellAbout(Wnd, PChar(AppName), PChar(Stuff), Icon);
{$ELSE}
  StrPLCopy(szApp, AppName, SizeOf(szApp) - 1);
  StrPLCopy(szStuff, Stuff, SizeOf(szStuff) - 1);
  ShellAbout(Wnd, szApp, szStuff, Icon);
{$ENDIF}
end;

function GetLocalIP: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of char;
  I: Integer;
  GInitData: TWSADATA;

begin
  WSAStartup($101, GInitData);
  try
    Result := '';
    GetHostName(Buffer, SizeOf(Buffer));
    phe := GetHostByName(buffer);
    if phe = nil then
      Exit;
    pptr := PaPInAddr(Phe^.h_addr_list);
    I := 0;
    while pptr^[I] <> nil do
    begin
      result := StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
    end;
  finally
    WSACleanup;
  end;
end;
//以下是自定义函数，用于转换

function GUIDToString(const ClassID: TGUID): string;
var
  P: PWideChar;
begin
  StringFromCLSID(ClassID, P);
  Result := P;
  CoTaskMemFree(P);
end;

function StringToGUID(const StrClassID: string): TGUID;
begin
  CLSIDFromString(PWideChar(WideString(StrClassID)), Result);
end;
//测试是否有文件尾

function TestEOF(const Content: string): Boolean;
var
  EofChar: Char;
begin
  EofChar := Content[Length(Content)];
  Result := (Eofchar = Chr(26));
end;
end.