You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

469 lines
14 KiB
Plaintext

This file contains ambiguous Unicode characters!

This file contains ambiguous Unicode characters that may be confused with others in your current locale. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to highlight these characters.

unit U_MSG;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,u_op_seae_DsWebService,SoapHTTPClient,InvokeRegistry,
dxExEdtr, dxDBTLCl, dxGrClms, dxTL, dxDBCtrl, dxDBGrid, dxCntner, DB,
kbmMemTable, ExtCtrls, Menus, BusinessSkinForm, ActnList, bsSkinCtrls,
ADODB;
type
Tfrm_MSG = class(TForm)
MT1: TkbmMemTable;
MT1GID: TStringField;
MT1BSNO: TStringField;
MT1MSGDate: TStringField;
MT1SENDERNAME: TStringField;
MT1SENDERCOMPANYNAME: TStringField;
MT1FieldValue: TStringField;
MT1RECDate: TStringField;
ds1: TDataSource;
pnl1: TPanel;
pnl2: TPanel;
mmo2: TMemo;
dxDBGrid: TdxDBGrid;
colFX: TdxDBGridColumn;
colSenderCompany: TdxDBGridColumn;
colSender: TdxDBGridColumn;
colMESDate: TdxDBGridColumn;
colFieldValue: TdxDBGridMemoColumn;
spl1: TSplitter;
pm1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
dxDBGridColumn6: TdxDBGridColumn;
MT1Received: TStringField;
MT1SendMail: TStringField;
pnl3: TPanel;
btn1: TButton;
actlst1: TActionList;
act1: TAction;
act2: TAction;
pnl4: TPanel;
bsSkinButton1: TbsSkinButton;
act3: TAction;
bsSkinButton2: TbsSkinButton;
N4: TMenuItem;
chk1: TCheckBox;
Qry1: TADOQuery;
QryGetOpseae: TADOQuery;
procedure FormShow(Sender: TObject);
procedure getwebservice_ds;
procedure btn1Click(Sender: TObject);
procedure dxDBGridCustomDraw(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; ANode: TdxTreeListNode; AColumn: TdxDBTreeListColumn;
const AText: String; AFont: TFont; var AColor: TColor; ASelected,
AFocused: Boolean; var ADone: Boolean);
procedure N2Click(Sender: TObject);
procedure SetReceived(GID: string);
procedure SetReceivedList;
procedure N3Click(Sender: TObject);
procedure act1Execute(Sender: TObject);
procedure act2Execute(Sender: TObject);
procedure bsSkinButton1Click(Sender: TObject);
procedure act3Execute(Sender: TObject);
procedure bsSkinButton2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
private
mServiceSoap_Ds:DsWebServiceSoap;
mHttpRIO_ds:THTTPRIO;
XML :String;
BSNO:String;
function GetXML:integer;
public
procedure SetBSNO(_BSNO:String);
end;
var
frm_MSG: Tfrm_MSG;
implementation
uses u_data_share, u_sys_progress, u_op_seae,my_sys_function;
{$R *.dfm}
procedure Tfrm_MSG.FormShow(Sender: TObject);
var _i,MSGCount,p1,p2:integer;
block:string;
begin
MSGCount:= GetXML;
if (BSNO='') then begin
close;
end;
if (MSGCount>0) then begin
MT1.close;
for _i:=1 to MSGCount do begin
p1:=frm_data_share.GettimePotion(_i,'<MSGInfo>',xml);
p2:=frm_data_share.GettimePotion(_i,'</MSGInfo>',xml);
block:=Copy(xml,p1,p2-p1);
MT1.Open;
MT1.Edit;
MT1.Insert;
MT1['BSNO']:=frm_data_share.GetXMLValue('BSNO',block);
MT1['GID']:=frm_data_share.GetXMLValue('GID',block);
MT1['SENDERNAME']:=frm_data_share.GetXMLValue('SENDERNAME',block);
MT1['SENDERCOMPANYNAME']:=frm_data_share.GetXMLValue('SENDERCOMPANYNAME',block);
MT1['FieldValue']:=frm_data_share.REHH(frm_data_share.GetXMLValue('FieldValue',block));
MT1['MSGDate']:=frm_data_share.GetXMLValue('MSGDate',block);
MT1['RECDate']:=frm_data_share.GetXMLValue('RECDate',block);
MT1['Received']:=frm_data_share.GetXMLValue('Received',block);
MT1['SendMail']:=frm_data_share.GetXMLValue('SendMail',block);
MT1.Post;
end;
//label14.Caption:='<27><><EFBFBD><EFBFBD>'+#10+'˵<><CBB5>';
// MT1.Open;
MT1.Last;
end;
//ˢ<><CBA2>
{
MSGCount:= GetXML;
if (MSGCount>0) then begin
mmo1.Clear;
for _i:=1 to MSGCount do begin
p1:=frm_data_share.GettimePotion(_i,'<MSGInfo>',xml);
p2:=frm_data_share.GettimePotion(_i,'</MSGInfo>',xml);
block:=Copy(xml,p1,p2-p1);
mmo1.Lines.Add(frm_data_share.GetXMLValue('SENDERNAME',block)+' '+frm_data_share.GetXMLValue('MSGDate',block));
mmo1.Lines.Add(frm_data_share.GetXMLValue('FieldValue',block));
end;
mmo1.SelStart := Length(mmo1.Text);
mmo1.SelLength:= Length(mmo1.Text);//0;
end; }
end;
function Tfrm_MSG.GetXML: integer;
var _s,url,block:string;
p1,p2,MSGCount:integer;
begin
if not ASSIGNED(frm_sys_progress) then
frm_sys_progress:=tfrm_sys_progress.Create(application);
frm_sys_progress.bsSkinGauge1.ProgressText:='<27><><EFBFBD>ڻ<EFBFBD>ȡ<EFBFBD><C8A1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Ⱥ򡣡<C8BA><F2A1A3A1><EFBFBD>';
frm_sys_progress.bsSkinGauge1.MaxValue:=100;
frm_sys_progress.bsSkinGauge1.MinValue:=0;
frm_sys_progress.Show;
frm_sys_progress.bsSkinGauge1.Value:=0;
try
getwebservice_ds;
//<2F><>ȡ<EFBFBD><C8A1>ҵ<EFBFBD><D2B5><EFBFBD>Ĺ<EFBFBD>ͨ<EFBFBD><CDA8>Ϣ
_s:='<?xml version="1.0" encoding="UTF-8" standalone="no"?> ';
_s:=_s+' <UserInfo xmlns="urn:Declaration:datamodel:standard:CN:MT2101:1"> ';
_s:=_s+' <UserList> ';
_s:=_s+' <User> ';
_s:=_s+' <UserID>'+frm_data_share.t_load_employee.fieldbyname('<27><><EFBFBD><EFBFBD>ϵͳ<CFB5><CDB3><EFBFBD>к<EFBFBD>').asstring+'</UserID> ';
// _s:=_s+' <USERNAME>SENDERCOMPANYID</USERNAME> ';
_s:=_s+' <BSNO>'+BSNO+'</BSNO> ';
_s:=_s+' </User> ';
_s:=_s+' </UserList> ';
_s:=_s+' </UserInfo> ';
//ShowMessage(_s);
XML:=mServiceSoap_Ds.ReceiveMSG(_s);
XML:=StringReplace(XML,'#$A','',[rfReplaceAll]);
p1:=frm_data_share.GettimePotion(1,'<MSGList>',XML);
p2:=frm_data_share.GettimePotion(1,'</MSGList>',xml);
XML:=copy(XML,p1,p2-p1);
//ShowMessage(XML);
MSGcount:= frm_data_share.countString('MSGInfo',xml);
result:= MSGcount;
finally
frm_sys_progress.Close;
frm_sys_progress.Free;
frm_sys_progress:=nil;
if (XML='') then begin
result:=0;
//showmessage('û<><C3BB><EFBFBD><EFBFBD><EFBFBD>ӵ<EFBFBD><D3B5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
end;
end;
//if assigned(MT1) then MT1.first;
end;
procedure Tfrm_MSG.getwebservice_ds;
var URL:String;
begin
try
URL:=get_WebseviceURL;
mHttpRIO_ds:=THTTPRIO.Create(nil);
mHttpRIO_ds.WSDLLocation:=URL+'?WSDL';
mHttpRIO_ds.URL:=URL;
mHttpRIO_ds.Port:='DsWebServiceSoap';
mHttpRIO_ds.Service:='DsWebService';
mHttpRIO_ds.HTTPWebNode.UseUTF8InHeader:=true;
InvRegistry.RegisterInvokeOptions(TypeInfo(DsWebServiceSoap),ioDocument );//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>һ<EFBFBD><D2BB>
mServiceSoap_Ds:=mHttpRIO_ds as DsWebServiceSoap;
except
on E:Exception do
begin
ShowMessage(e.Message);
exit;
end;
end;
end;
procedure Tfrm_MSG.btn1Click(Sender: TObject);
var company:string;
begin
if mmo2.Lines.text<>'' then begin
getwebservice_ds;
_s:='<?xml version="1.0" encoding="UTF-8" standalone="no"?>';
_s:=_s+'<BookingMSG xmlns="urn:Declaration:datamodel:standard:CN:MT2101:1">';
_s:=_s+'<MSGList> ';
_s:=_s+' <MSGInfo> ';
_s:=_s+' <SENDERID>'+frm_data_share.t_load_employee.fieldbyname('<27><><EFBFBD><EFBFBD>ϵͳ<CFB5><CDB3><EFBFBD>к<EFBFBD>').asstring+'</SENDERID> ';
_s:=_s+' <BSTYPE><3E><>ͨ<EFBFBD><CDA8>Ϣ</BSTYPE> ';
_s:=_s+' <BSNO>'+BSNO+'</BSNO> ';
_s:=_s+' <FieldName><3E><>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD></FieldName> ';
_s:=_s+' <FieldValue>'+mmo2.Lines.Text+'</FieldValue> ';
if (chk1.Checked) then begin
_s:=_s+' <SendMail>Send</SendMail> ';
end;
_s:=_s+' </MSGInfo> ';
_s:=_s+'</MSGList> ';
_s:=_s+'</BookingMSG> ';
XML:=mServiceSoap_Ds.SendMSG(_s);
//showmessage(XML);
if (pos('<USERNAME>',XML)>0) then begin
Qry1.Close;
Qry1.SQL.Text:='select '''+mmo2.Lines.Text+''' <20><>Ϣ';
Qry1.Open;
qryGetOpseae.Close;
qryGetOpseae.Parameters.ParamByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>к<EFBFBD>').Value := MT1.fieldbyname('BSNO').asstring;
qryGetOpseae.Open;
Booking_add(Qry1, qryGetOpseae.fieldbyname('<27><><EFBFBD><EFBFBD>').asstring
, XML, MT1.fieldbyname('BSNO').asstring
, '<27><><EFBFBD><EFBFBD> <20><>ͨ<EFBFBD><CDA8>Ϣ');
mmo2.Clear;
FormShow(self);
end else begin
showmessage('<27><><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>');
end;
end else begin
FormShow(self);
end;
end;
procedure Tfrm_MSG.dxDBGridCustomDraw(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; ANode: TdxTreeListNode; AColumn: TdxDBTreeListColumn;
const AText: String; AFont: TFont; var AColor: TColor; ASelected,
AFocused: Boolean; var ADone: Boolean);
begin
//ShowMessage(ANode.Strings[dxDBGridColumn6.Index]);
if (ANode.Strings[colFX.Index]='δ<><CEB4>') then begin
AFont.Style:=[fsBold];
end;
if ANode.Index mod 2 = 0 then
AColor := clWhite
else
AColor := clLtGray;
end;
procedure Tfrm_MSG.SetReceived(GID: string);
//<2F><EFBFBD><E8B6A8>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD>
var _s,XML :string;
begin
//<2F><><EFBFBD><EFBFBD>
if (MT1.FieldByName('Received').AsString='δ<><CEB4>') then begin
getwebservice_ds;
_s:='<?xml version="1.0" encoding="UTF-8" standalone="no"?>';
_s:=_s+'<BookingMSG xmlns="urn:Declaration:datamodel:standard:CN:MT2101:1">';
_s:=_s+'<MSGList> ';
_s:=_s+' <MSGInfo> ';
_s:=_s+' <SENDERID>'+frm_data_share.t_load_employee.fieldbyname('<27><><EFBFBD><EFBFBD>ϵͳ<CFB5><CDB3><EFBFBD>к<EFBFBD>').asstring+'</SENDERID> ';
_s:=_s+' <BSTYPE><3E><>ͨ<EFBFBD><CDA8>Ϣ</BSTYPE> ';
_s:=_s+' <GID>'+GID+'</GID> ';
_s:=_s+' <FieldName><3E><>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD></FieldName> ';
//_s:=_s+' <FieldValue>'+mmo1.Lines.Text+'</FieldValue> ';
_s:=_s+' </MSGInfo> ';
_s:=_s+'</MSGList> ';
_s:=_s+'</BookingMSG> ';
XML:=mServiceSoap_Ds.SetMSGRec(_s);
if (pos('<27>ɹ<EFBFBD>',XML)>0) then begin
MT1.edit;
MT1['Received']:='<27>Ѷ<EFBFBD>';
MT1.Post;
qryGetOpseae.Close;
qryGetOpseae.Parameters.ParamByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>к<EFBFBD>').Value := MT1.fieldbyname('BSNO').asstring;
qryGetOpseae.Open;
Qry1.Close;
Qry1.SQL.Text:='select '''+MT1.fieldbyname('FieldValue').AsString+''' <20><>Ϣ';
Qry1.Open;
Booking_add(Qry1, qryGetOpseae.fieldbyname('<27><><EFBFBD><EFBFBD>').asstring
, MT1.fieldbyname('SENDERNAME').AsString
, MT1.fieldbyname('SENDERCOMPANYNAME').AsString
, qryGetOpseae.fieldbyname('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>к<EFBFBD>').asstring, '<27><><EFBFBD><EFBFBD> <20><>ͨ<EFBFBD><CDA8>Ϣ');
end else begin
//showmessage('<27><><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>');
end;
end;
end;
procedure Tfrm_MSG.SetReceivedList;
//<2F><EFBFBD><E8B6A8>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD>
var _s,XML :string;
begin
//<2F><><EFBFBD><EFBFBD>
getwebservice_ds;
_s:='<?xml version="1.0" encoding="UTF-8" standalone="no"?>';
_s:=_s+'<BookingMSG xmlns="urn:Declaration:datamodel:standard:CN:MT2101:1">';
_s:=_s+'<MSGList> ';
_s:=_s+' <MSGInfo> ';
_s:=_s+' <RECEIVERID>'+frm_data_share.t_load_employee.fieldbyname('<27><><EFBFBD><EFBFBD>ϵͳ<CFB5><CDB3><EFBFBD>к<EFBFBD>').asstring+'</RECEIVERID> ';
_s:=_s+' <BSTYPE><3E><>ͨ<EFBFBD><CDA8>Ϣ</BSTYPE> ';
_s:=_s+' <BSNO>'+BSNO+'</BSNO> ';
_s:=_s+' <FieldName><3E><>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD></FieldName> ';
//_s:=_s+' <FieldValue>'+mmo1.Lines.Text+'</FieldValue> ';
_s:=_s+' </MSGInfo> ';
_s:=_s+'</MSGList> ';
_s:=_s+'</BookingMSG> ';
XML:=mServiceSoap_Ds.SetMSGRec(_s);
if (pos('<27>ɹ<EFBFBD>',XML)>0) then begin
MT1.First;
qryGetOpseae.Close;
qryGetOpseae.Parameters.ParamByName('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>к<EFBFBD>').Value := MT1.fieldbyname('BSNO').asstring;
qryGetOpseae.Open;
while not MT1.Eof do begin
if (MT1.FieldByName('Received').AsString='δ<><CEB4>') then begin
MT1.edit;
MT1['Received']:='<27>Ѷ<EFBFBD>';
MT1.Post;
Qry1.Close;
Qry1.SQL.Text:='select '''+MT1.fieldbyname('FieldValue').AsString+''' <20><>Ϣ';
Qry1.Open;
Booking_add(Qry1, qryGetOpseae.fieldbyname('<27><><EFBFBD><EFBFBD>').asstring
, MT1.fieldbyname('SENDERNAME').AsString
, MT1.fieldbyname('SENDERCOMPANYNAME').AsString
, qryGetOpseae.fieldbyname('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>к<EFBFBD>').asstring, '<27><><EFBFBD><EFBFBD> <20><>ͨ<EFBFBD><CDA8>Ϣ');
end;
MT1.next;
end;
end else begin
//showmessage('<27><><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>');
end;
end;
procedure Tfrm_MSG.N2Click(Sender: TObject);
begin
SetReceived(MT1.fieldbyname('GID').asstring);
end;
procedure Tfrm_MSG.N3Click(Sender: TObject);
begin
SetReceivedList;
end;
procedure Tfrm_MSG.act1Execute(Sender: TObject);
begin
btn1Click(self);
end;
procedure Tfrm_MSG.act2Execute(Sender: TObject);
var _TB:Boolean;
begin
_TB:= chk1.Checked;
chk1.Checked:=True;
btn1Click(self);
chk1.Checked:= _TB;
bsSkinButton2Click(self);
end;
procedure Tfrm_MSG.SetBSNO(_BSNO: String);
begin
BSNO:=_BSNO;
end;
procedure Tfrm_MSG.bsSkinButton1Click(Sender: TObject);
begin
FormShow(self);
end;
procedure Tfrm_MSG.act3Execute(Sender: TObject);
begin
FormShow(self);
end;
procedure Tfrm_MSG.bsSkinButton2Click(Sender: TObject);
begin
chk1.Checked:= not chk1.Checked;
{ if mmo2.Lines.text<>'' then begin
getwebservice_ds;
_s:='<?xml version="1.0" encoding="UTF-8" standalone="no"?>';
_s:=_s+'<BookingMSG xmlns="urn:Declaration:datamodel:standard:CN:MT2101:1">';
_s:=_s+'<MSGList> ';
_s:=_s+' <MSGInfo> ';
_s:=_s+' <SENDERID>'+frm_data_share.t_load_employee.fieldbyname('<27><><EFBFBD><EFBFBD>ϵͳ<CFB5><CDB3><EFBFBD>к<EFBFBD>').asstring+'</SENDERID> ';
_s:=_s+' <BSTYPE><3E><>ͨ<EFBFBD><CDA8>Ϣ</BSTYPE> ';
_s:=_s+' <BSNO>'+BSNO+'</BSNO> ';
_s:=_s+' <FieldName><3E><>Ϣ<EFBFBD><CFA2><EFBFBD><EFBFBD></FieldName> ';
_s:=_s+' <FieldValue>'+mmo2.Lines.Text+'</FieldValue> ';
_s:=_s+' <SendMail>Send</SendMail> ';
_s:=_s+' </MSGInfo> ';
_s:=_s+'</MSGList> ';
_s:=_s+'</BookingMSG> ';
XML:=mServiceSoap_Ds.SendMSG(_s);
if (pos('<27>ɹ<EFBFBD>',XML)>0) then begin
mmo2.Clear;
FormShow(self);
end else begin
showmessage('<27><><EFBFBD><EFBFBD>ʧ<EFBFBD><CAA7>');
end;
end else begin
FormShow(self);
end; }
end;
procedure Tfrm_MSG.N4Click(Sender: TObject);
begin
keybd_event(17,0,0,0);
keybd_event(67,0,0,0);
keybd_event(67,0,KEYEVENTF_KEYUP,0);
keybd_event(17,0,KEYEVENTF_KEYUP,0);
end;
end.