unit1.pas

a program written by delphi about middle layer

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MCONNECT, ExtCtrls, ScktComp, Buttons;


type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    edtCon: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button7: TButton;
    csCon: TClientSocket;
    Edit4: TEdit;
    Edit5: TEdit;
    Label1: TLabel;
    tmcs: TTimer;
    Edit1: TEdit;
    Button8: TButton;
    ListBox1: TListBox;
    SpeedButton1: TSpeedButton;
    Edit6: TEdit;
    Edit7: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure csConError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure csConConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csConDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure csConRead(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
    procedure SetClientStatus(b: boolean);
    procedure ConnectConServer;
    function pacs_frmae_checksum(s: string): string;
    function phrase(ir: string; s: string): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  function ShowImage(StrShow:PChar):boolean;stdcall;
  far;external 'HISMessage.dll' name 'ShowImage';


implementation

{$R *.dfm}
//uses
procedure pacs_open_socket(node: string);
          external 'pacs.dll';
procedure pacs_register(pchkid: integer);
          external 'pacs.dll';
procedure pacs_capture(pchkcard: string);
          external 'pacs.dll';
procedure pacs_display(pchkcard: string);
          external 'pacs.dll';
function  pacs_open_register_socket(): boolean;
          external 'pacs.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
    pacs_open_socket('1201');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    pacs_register(8);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
    buf: string;
begin
    //pacs_capture(trim(edit2.Text));
    buf := #02 + '|F|2' + '|A|' + edit2.Text + #03 + pacs_frmae_checksum('|F|2' + '|A|' + edit2.Text);
    csCon.Socket.SendText(buf);
end;

procedure TForm1.Button4Click(Sender: TObject);
var
    buf: string;
begin
    //pacs_display(trim(edit3.Text));
    buf := #02 + '|F|3' + '|A|' + edit3.Text + '|X|' + edit7.Text + #03 + pacs_frmae_checksum('|F|3' + '|A|' + edit3.Text + '|X|' + edit7.Text);
    showmessage(buf);
    ShowImage(PChar(buf));
    //csCon.Socket.SendText(buf);
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
    pacs_open_register_socket;
end;

procedure TForm1.csConError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
    SetClientStatus(false);
    //ErrorCode := 0;
    tmcs.Enabled := true;
    //raise;
end;

procedure TForm1.csConConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
    SetClientStatus(true);
    tmcs.Enabled := false;
end;

procedure TForm1.csConDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    SetClientStatus(false);
    tmcs.Enabled := true;
end;

procedure TForm1.SetClientStatus(b: boolean);
begin
    if b then
        label1.Caption := '已连接'
    else
        label1.Caption := '未连接';
end;

procedure TForm1.Button6Click(Sender: TObject);
var
    buf : string;
begin
    buf := edtCon.Text;
    buf := #02 + buf + #03 + pacs_frmae_checksum(buf);
    //buf := #02
    csCon.Socket.SendText(buf);
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
    ConnectConServer;
end;

function TForm1.pacs_frmae_checksum(s: string): string;
var
    i, j, k: integer;
begin
    j := 0;
    k := 256;
    for i := 1 to length(s) do
        j := j + ord(s[i]);
    j := j mod k;

    result := IntToHex(j, 2);
end;

procedure TForm1.ConnectConServer;
begin
  tmcs.Enabled := False;
  csCon.Close;
  csCon.Address := edit4.Text;
  csCon.Port := StrToInt(edit5.Text);
  csCon.Open;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    edtCon.Text := '20061218100';
end;

procedure TForm1.Button8Click(Sender: TObject);
var
    s: string;
begin
    s := trim(edit1.Text);
    with listbox1.Items do
    begin
        clear;
        Add('|F|' + phrase('|F|', s));
        Add('|A|' + phrase('|A|', s));
        Add('|B|' + phrase('|B|', s));
        Add('|C|' + phrase('|C|', s));
        Add('|N|' + phrase('|N|', s));
        Add('|O|' + phrase('|O|', s));
        Add('|V|' + phrase('|V|', s));
    end;
end;

function TForm1.phrase(ir: string; s: string): string;
var
    i, j: integer;
    s1: string;
begin
    i := pos(ir, s);
    if i <= 0 then result := 'ERR';
    s1 := copy(s, i + 3, length(s) - i);
    j := pos('|', s1);
    if j > 0 then
    begin
        result := copy(s1, 1, pos('|', s1) - 1 );
        exit;
    end;
    j := length(s) - i - 3;
    if j = 0 then
    begin
        result := '';
        exit;
    end
    else
    begin
        result := copy(s, i + 3, length(s));
        exit;
    end;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
    csCon.Active := false;
end;

procedure TForm1.csConRead(Sender: TObject; Socket: TCustomWinSocket);
var
    s: string;
begin
    s := Socket.ReceiveText;
    edit6.Text := s;
end;

end.