⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main_u.~pas

📁 delphi实现 webservice的例子.有服务端和客户段 利用xml交互.
💻 ~PAS
字号:
unit main_U;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, RzEdit, Mask, StdCtrls, RzButton, RzCmboBx, RzLabel,
  ExtCtrls, RzPanel, RzSpnEdt,jpeg,ProductBinding;

type
  TaMainForm = class(TForm)
    pgc1: TPageControl;
    ts1: TTabSheet;
    lbl1: TLabel;
    lbl2: TLabel;
    edtCode: TEdit;
    edtPid: TEdit;
    lbl3: TLabel;
    edtName: TEdit;
    lbl4: TLabel;
    edtModel: TEdit;
    lbl5: TLabel;
    lbl6: TLabel;
    edtUnit: TEdit;
    lbl7: TLabel;
    lbl8: TLabel;
    lbl9: TLabel;
    lbl10: TLabel;
    lbl11: TLabel;
    lbl12: TLabel;
    lbl13: TLabel;
    lbl14: TLabel;
    edtTheCurrency: TEdit;
    edtCategory: TEdit;
    edtOnSaleDate: TRzDateTimeEdit;
    edtWithDrawDate: TRzDateTimeEdit;
    edtWeight: TRzNumericEdit;
    edtOriginalcode: TEdit;
    edtLocus: TEdit;
    edtPsize: TEdit;
    edtColor: TEdit;
    btn1: TButton;
    ts2: TTabSheet;
    img1: TImage;
    rzpnl1: TRzPanel;
    lbl15: TRzLabel;
    cbbformat: TRzComboBox;
    cbbface: TRzComboBox;
    lbl16: TRzLabel;
    cbbsize: TRzComboBox;
    lbl17: TRzLabel;
    btn2: TRzButton;
    lbl18: TRzLabel;
    edtbh: TRzEdit;
    ts3: TTabSheet;
    mmo1: TRzMemo;
    lbl19: TRzLabel;
    lbl20: TRzLabel;
    edtDays1: TRzSpinEdit;
    edtDays: TRzSpinEdit;
    btn3: TRzButton;
    btn4: TRzButton;
    lbl21: TRzLabel;
    edtbh1: TRzEdit;
    btn5: TRzButton;
    btn6: TRzButton;
    btn7: TRzButton;
    lbl22: TLabel;
    mmoSummary: TRzMemo;
    edtGrade: TEdit;
    lbl23: TLabel;
    OpenDialog1: TOpenDialog;
    procedure edtCodeKeyPress(Sender: TObject; var Key: Char);
    procedure btn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btn6Click(Sender: TObject);
    procedure btn7Click(Sender: TObject);

    Function  GetCode():string;
    procedure btn2Click(Sender: TObject);
    procedure ShowImage(ImageStr:WideString);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
    procedure btn5Click(Sender: TObject);
    procedure ShowProduct(msg :TReturnPtypeListMsg);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  aMainForm: TaMainForm;

implementation
   uses
     ComFun,Variable_U,imageinfo;
{$R *.dfm}

procedure TaMainForm.edtCodeKeyPress(Sender: TObject; var Key: Char);
begin
  MyKeyPress(Self,Key);
end;

procedure TaMainForm.btn1Click(Sender: TObject);
var
 product :TXmlProductType;
 dataXml:WideString;
 msg:TReturnMsg;
begin
  if(edtCode.Text='') or (edtPid.Text='') or (edtName.Text='') then
  begin
     ShowMessage('商品编号或名称不能为空');
     exit;
    end;
  product :=TXmlProductType.Create;
  product.pid :=edtPid.Text;
  product.name :=edtName.Text;
  product.model :=edtModel.Text;
  product.sunit :=edtUnit.Text;
  product.thecurrency :=edtTheCurrency.text;
  product.category :=edtCategory.Text;
  product.pictures :='';
  product.onsaledate :=edtOnSaleDate.Text;
  product.withdrawdate :=edtWithDrawDate.Text;
  product.weight :=StrToIntDef(edtWeight.Text,0);
  product.originalcode :=edtOriginalcode.Text;
  product.summary :=mmoSummary.Lines.Text;
  product.locus :=edtLocus.Text;
  product.color :=edtColor.Text;
  product.grade :=edtGrade.Text;
  product.UserCode :=ClientCFG.UserID;
  product.pid :=product.UserCode+'.'+product.pid;

  dataXml :=CreateXmlFromProduct(product);
  try
  dataXml := GetService.UpdateProduct(dataXml);
  msg:=GetResultMsg(dataXml);
  if msg.ResultCode='1' then
   ShowMessage('更新成功')
  else
   ShowMessage('更新失败,'+msg.ResultDesc);
  except on e:Exception do
       ShowMessage('更新失败,'+e.Message);
    end;
end;

procedure TaMainForm.FormShow(Sender: TObject);
begin
  edtCode.Text :=ClientCFG.UserID;
end;

procedure TaMainForm.btn6Click(Sender: TObject);
begin
 if opendialog1.Execute then
  img1.Picture.LoadFromFile(opendialog1.FileName);
  
end;

procedure TaMainForm.btn7Click(Sender: TObject);
var
imageinfo:TImageInfo;
code:String;
dataXml:WideString;
msg:TReturnMsg;
begin
 if opendialog1.FileName='' then exit;
 code :=GetCode();
 imageinfo :=Timageinfo.Create(opendialog1.FileName,edtbh.Text,code);
 dataXml :=CreatePictureXml(imageinfo,'','');
  try
  dataXml := GetService.PostProductImage(dataXml);
  msg:=GetResultMsg(dataXml);
  if msg.ResultCode='1' then
  begin
   ShowMessage('上传成功');
  end else
   ShowMessage('上传失败,'+msg.ResultDesc);
  except on e:Exception do
       ShowMessage('上传失败,'+e.Message);
    end;

end;
Function  TaMainForm.GetCode():string;
begin
 result :=trim(cbbsize.Text)+'#'+format('%000d',[cbbface.ItemIndex+1])+'#'+trim(cbbformat.Text);
end;
procedure TaMainForm.btn2Click(Sender: TObject);
var
 dataXml :WideString;
 msg:TReturnMsg;
begin
 dataXml :=CreateGetImageXml(edtbh.Text,getcode());
  try
  dataXml := GetService.GetProductImage(DataXml);
  msg:=GetResultMsg(dataXml);
  if msg.ResultCode='1' then
   ShowMessage('下载成功')
  else
   ShowMessage('下载失败,'+msg.ResultDesc);
  except on e:Exception do
       ShowMessage('下载失败,'+e.Message);
    end;
end;
procedure TaMainForm.ShowImage(ImageStr:WideString);
var
   bmp :TBitmap;
  // jpg:TJpeg;
   stream:TStream;
begin
 if cbbformat.Text='bmp' then
 begin
  bmp :=TBitmap.Create;
  try
   stream :=str2graphicStream(ImageStr);
   stream.Position :=0;
   bmp.LoadFromStream(stream);
   img1.Picture.Bitmap.Assign(bmp);
  finally
   stream.Free;
   bmp.FreeImage;
  end;
 end else
 begin
  try
   stream :=str2graphicStream(ImageStr);
   stream.Position :=0;
   img1.Picture.Graphic.LoadFromStream(stream);
  finally
   stream.Free;
  end;
 end;
end;
procedure TaMainForm.btn3Click(Sender: TObject);
var
 dateType:TdateType;
 dataXml:WideString;
 msg :TReturnListMsg;
begin
 dateType.DateType :='OnSaleDate';
 dateType.DateFieldName :='OnSaleDate';
 dateType.Days :=edtDays1.IntValue;
 dataXml :=CreateDateXml(dateType);
  try
  dataXml := GetService.GetProductByDate(dataXml);
  msg:=ReadProdcutList(dataXml);
  if msg.ResultCode='1' then
  begin
   mmo1.Lines :=msg.ProductList;
  end else
   ShowMessage('下载失败,'+msg.ResultDesc);
  except on e:Exception do
       ShowMessage('下载失败,'+e.Message);
    end;
end;

procedure TaMainForm.btn4Click(Sender: TObject);
var
 dateType:TdateType;
 dataXml:WideString;
 msg :TReturnListMsg;
begin
 dateType.DateType :='WithDrawDate';
 dateType.DateFieldName :='WithDrawDate';
 dateType.Days :=edtDays.IntValue;
 dataXml :=CreateDateXml(dateType);
  try
  dataXml := GetService.GetProductByDate(dataXml);
  msg:=ReadProdcutList(dataXml);
  if msg.ResultCode='1' then
  begin
   mmo1.Lines :=msg.ProductList;
  end else
   ShowMessage('下载失败,'+msg.ResultDesc);
  except on e:Exception do
       ShowMessage('下载失败,'+e.Message);
    end;
end;

procedure TaMainForm.btn5Click(Sender: TObject);
var
 dataXml:WideString;
 msg :TReturnPtypeListMsg;
begin
  dataXml :=CreatePidXml(edtbh1.Text);
  try
  dataXml := GetService.GetProduct(dataXml);
  msg:=GetProductinfo(dataXml);
  if msg.ResultCode='1' then
  begin
   ShowProduct(msg); //显示商品信息
   msg.ProductList.Free;
  end else
   ShowMessage('下载失败,'+msg.ResultDesc);
  except on e:Exception do
       ShowMessage('下载失败,'+e.Message);
    end;
end;

procedure TaMainForm.ShowProduct(msg :TReturnPtypeListMsg);
var
 product:TXmlProductType;
begin
  if msg.ProductList.Count=0 then exit;
   Product :=TXmlProductType(msg.ProductList[0]);
   edtPid.Text :=product.pid;
   edtName.Text := product.name;
   edtModel.Text:=product.model;
   edtUnit.Text:=product.sunit;
   edtTheCurrency.text:=product.thecurrency;
   edtCategory.Text:=product.category;
   //edtpictures.text:=product.pictures :='';
   edtOnSaleDate.Text:=product.onsaledate;
   edtWithDrawDate.Text:=product.withdrawdate;
   edtWeight.Text:=inttostr(product.weight);
   edtOriginalcode.Text:=product.originalcode;
   mmoSummary.Lines.Text:=product.summary;
   edtLocus.Text:=product.locus;
   edtColor.Text:=product.color;
   edtGrade.Text:=product.grade;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -