码农的笔记

Delphi虽好，但已不流行； 博客真好，可以做笔记
博客园 首页 新随笔 联系 订阅 管理
Delphi之Web提交表单到服务器

---------------开发环境D7------

需要Uses superobject,superobject需要下载

本人电脑上有Web服务器,提供Web服务，

JSON数据形式：[{"name":"A000000","teacher":"Tea000000","classroom":"C_R000000"},{"name":"A000001","teacher":"Tea000001","classroom":"C_R000001"},{"name":"A000002","teacher":"Tea000002","classroom":"C_R000002"},{"name":"A000003","teacher":"Tea000003","classroom":"C_R000003"},{"name":"A000004","teacher":"Tea000004","classroom":"C_R000004"},{"name":"A000005","teacher":"Tea000005","classroom":"C_R000005"}]

 

下图，通过Http访问Web后台，返回JSON数据，然后再解析数据

 

 

 

仅学习使用

---------------------------------

 

-------Unit开始----

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxControls, cxLookAndFeels, cxLookAndFeelPainters,
cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxSpinEdit, cxDBEdit,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
StdCtrls, RzSpnEdt, Mask, RzEdit, Spin, DB, DBClient, Grids, DBGrids,
ComCtrls, ExtCtrls,IdMultipartFormData,superobject,MidasLib; //,MidasLib

type
TForm1 = class(TForm)
IdHTTP1: TIdHTTP;
SpinEdit1: TSpinEdit;
Edit1: TEdit;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Button1: TButton;
TabSheet2: TTabSheet;
DataSource1: TDataSource;
ClientDataSet1: TClientDataSet;
ClientDataSet1name: TStringField;
ClientDataSet1teacher: TStringField;
ClientDataSet1classroom: TStringField;
Panel1: TPanel;
DBGrid1: TDBGrid;
Panel2: TPanel;
Button2: TButton;
button_Insert: TButton;
IdTCPClient1: TIdTCPClient;
TabSheet3: TTabSheet;
Memo1: TMemo;
Button4: TButton;
Button5: TButton;
DBGrid2: TDBGrid;
Label4: TLabel;
Label5: TLabel;
ListBox1: TListBox;
name_small: TEdit;
name_big: TEdit;
Label_datadec: TLabel;
Label_dataTran: TLabel;
procedure PageControl1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure button_InsertClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
str01:string;
implementation

{$R *.dfm}

procedure TForm1.PageControl1Change(Sender: TObject);
begin
//if PageControl1.ActivePage = TabSheet2 then
// ShowMessage('00');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i:Integer;
begin
with ClientDataSet1 do
begin
Active:=false;
if 1=1 then
begin
CreateDataSet;
with IndexDefs do
begin
Clear;
with AddIndexDef do
begin
Name := 'Idx_name';
Fields := 'name';
end;
end;
IndexName := 'Idx_name';
end;

Active:=false;
Active:=true;
EmptyDataSet;
for i := 0 to 100000 do
begin
Append;
FieldByName('name').Value := FormatFloat('000000',i);
FieldByName('teacher').Value :='T'+inttostr(i);
FieldByName('classroom').Value :='CR'+inttostr(i);
post;
end;
end;
end;

procedure TForm1.Button4Click(Sender: TObject);

var
//postStream : TIdMultiPartFormDataStream;
postStream,respStream : TStringStream;
ContentStream1 : TStream;
s:string;
i:Integer;
a,b,c:Integer;
str:string;
begin
//IdHTTP1.HandleRedirects := true; // 允许重定向，因为这个站点会发生重定向
//IdHTTP1.Request.Referer := 'http://192.168.1.50:8080/Course/selectlist.jsp'; // 设置来路，此网站要求


//postStream := TIdMultiPartFormDataStream.Create; // 创建TIdMultiPartFormDataStream类
respStream := TStringStream.Create('');
ContentStream1:=TmemoryStream.Create;
IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded'; // 定义发送mime类型
postStream := TStringStream.Create('&name_small='''+name_small.text+'''&name_big='''+name_big.text+'''&m='''+'1'+'''');
//postStream.AddFormField('name_small', name_small.text); // 表单参数
//postStream.AddFormField('name_big', name_big.text); // 表单参数

a:=GetTickCount;
IdHTTP1.post('http://192.168.1.50:8080/Course/courseServlet?method=returnjson',postStream,respStream);
//IdHTTP1.get('http://192.168.1.50:8080/Course/courseServlet?method=returnjson&name_small=''A000000''&name_big=''A000009''',respStream);
//IdHTTP1.get('http://192.168.1.50:8080/Course/courseServlet?method=returnjson&name_small='''+name_small.text+'''&name_big='''+name_big.text+'''',respStream);

b:=GetTickCount;
Label4.Caption :='耗时(ms): '+IntToStr(b-a);
//Memo1.Text := respStream.DataString;
str:=Utf8ToAnsi(respStream.DataString);
str01:=str;
//ListBox1.Items.Add(respStream.DataString);
c:=GetTickCount;
Label5.Caption :='耗时(ms): '+IntToStr(c-b);
//Memo1.Text :=str;
{ContentStream1:=IdHTTP1.Response.ContentStream ;
SetLength(s, ContentStream1.Size) ;
for I := 0 to Pred(ContentStream1.Size) do
begin
ContentStream1.Position := I;
ContentStream1.Read(s[Succ(I)], 1);
end;}

//Memo1.Text :=s; ;

//Memo1.Text := Utf8ToAnsi(IdHTTP1.post('http://192.168.1.50:8080/Course/courseServlet?method=select',postStream));
end;


procedure TForm1.Button5Click(Sender: TObject);
var
i,a,b,c:Integer;
str:string;
jo:ISuperObject ;
item: TSuperObjectIter;
begin
if (str01='[]')or(str01='[') then
begin
ShowMessage('没有数据');
exit;
end;
with ClientDataSet1 do
begin
Active:=false;
if 1=1 then
begin
CreateDataSet;
with IndexDefs do
begin
Clear;
with AddIndexDef do
begin
Name := 'Idx_name';
Fields := 'name';
end;
end;
IndexName := 'Idx_name';
end;

Active:=false;
Active:=true;
EmptyDataSet;
str:=str01 ;
a:=GetTickCount ;
//System.Delete(str,1,2);

//str:='['+str;

jo := SO(str);
b:=GetTickCount ;
Label_dataTran.Caption :='耗时(ms): '+inttostr(b-a);
//Memo1.Text := str;
//ShowMessage(jo.AsArray[0]['name'].AsString);
//showmessage(inttostr(jo.AsArray.Length));

for i:=0 to jo.AsArray.Length-1 do //jo.AsArray.Length-1
begin
Append;
FieldByName('name').Value := jo.AsArray[i]['name'].AsString;
FieldByName('teacher').Value :=jo.AsArray[i]['teacher'].AsString;
FieldByName('classroom').Value :=jo.AsArray[i]['classroom'].AsString;

end;
post;
c:=GetTickCount;

Label_datadec.Caption :='耗时(ms): '+inttostr(c-b);
{ if arrayFindFirst(jo, item) then
repeat
ShowMessageFmt('key: %s; val: %s', [item.key, item.val.AsString]);
until not ObjectFindNext(item);
ObjectFindClose(item);
}

end;

end;

procedure TForm1.Button1Click(Sender: TObject);
var
//postStream : TIdMultiPartFormDataStream;
postStream,respStream : TStringStream;
ContentStream1 : TStream;
s:string;
i:Integer;
a,b,c:Integer;
str:string;
begin
//IdHTTP1.HandleRedirects := true; // 允许重定向，因为这个站点会发生重定向
//IdHTTP1.Request.Referer := 'http://192.168.1.50:8080/Course/selectlist.jsp'; // 设置来路，此网站要求


//postStream := TIdMultiPartFormDataStream.Create; // 创建TIdMultiPartFormDataStream类
respStream := TStringStream.Create('');
ContentStream1:=TmemoryStream.Create;
IdHTTP1.Request.ContentType := 'application/x-www-form-urlencoded'; // 定义发送mime类型
postStream := TStringStream.Create('&name_small='''+name_small.text+'''&name_big='''+name_big.text+'''');
//postStream.AddFormField('name_small', name_small.text); // 表单参数
//postStream.AddFormField('name_big', name_big.text); // 表单参数


IdHTTP1.post('http://192.168.1.50:8080/Course/courseServlet?method=add',postStream,respStream);
str:=Utf8ToAnsi(respStream.DataString);
str01:=str;
//ListBox1.Items.Add(respStream.DataString);
c:=GetTickCount;
Label5.Caption :='耗时(ms): '+IntToStr(c-b);
//Memo1.Text :=str;
{ContentStream1:=IdHTTP1.Response.ContentStream ;
SetLength(s, ContentStream1.Size) ;
for I := 0 to Pred(ContentStream1.Size) do
begin
ContentStream1.Position := I;
ContentStream1.Read(s[Succ(I)], 1);
end;}

//Memo1.Text :=s; ;

//Memo1.Text := Utf8ToAnsi(IdHTTP1.post('http://192.168.1.50:8080/Course/courseServlet?method=select',postStream));
end;

procedure TForm1.button_InsertClick(Sender: TObject);
begin
//button_Insert
end;

end.

//[delphi]indy?idhttp?post方法?处理表单_我舞耀扬_新浪博客 http://blog.sina.com.cn/s/blog_4e45b8430102vg66.html

-------Unit结束------------

---------Form开始---------------

object Form1: TForm1
Left = 519
Top = 279
Width = 619
Height = 452
Caption = 'Form1'
Color = clBtnFace
Constraints.MaxHeight = 452
Constraints.MaxWidth = 619
Constraints.MinHeight = 452
Constraints.MinWidth = 619
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object SpinEdit1: TSpinEdit
Left = 16
Top = 40
Width = 121
Height = 22
MaxValue = 0
MinValue = 0
TabOrder = 0
Value = 8080
end
object Edit1: TEdit
Left = 16
Top = 8
Width = 385
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 1
Text = 'Edit1'
end
object PageControl1: TPageControl
Left = 16
Top = 72
Width = 569
Height = 305
ActivePage = TabSheet3
TabOrder = 2
OnChange = PageControl1Change
object TabSheet1: TTabSheet
Caption = 'TabSheet1'
object Label1: TLabel
Left = 17
Top = 112
Width = 88
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '课程名称'
end
object Label2: TLabel
Left = 25
Top = 144
Width = 80
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '任课教师'
end
object Label3: TLabel
Left = 33
Top = 176
Width = 80
Height = 13
Alignment = taRightJustify
AutoSize = False
Caption = '上课地点'
end
object Edit2: TEdit
Left = 144
Top = 112
Width = 121
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 0
Text = 'Edit2'
end
object Edit3: TEdit
Left = 144
Top = 144
Width = 121
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 1
Text = 'Edit3'
end
object Edit4: TEdit
Left = 144
Top = 176
Width = 121
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 2
Text = 'Edit4'
end
object Button1: TButton
Left = 118
Top = 216
Width = 75
Height = 25
Caption = '提交数据'
TabOrder = 3
OnClick = Button1Click
end
end
object TabSheet2: TTabSheet
Caption = 'TabSheet2'
ImageIndex = 1
object Panel1: TPanel
Left = 0
Top = 0
Width = 561
Height = 236
Align = alClient
Caption = 'Panel1'
TabOrder = 0
object DBGrid1: TDBGrid
Left = 1
Top = 1
Width = 559
Height = 234
Align = alClient
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 0
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
end
object Panel2: TPanel
Left = 0
Top = 236
Width = 561
Height = 41
Align = alBottom
TabOrder = 1
object Button2: TButton
Left = 8
Top = 16
Width = 75
Height = 25
Caption = 'test'
TabOrder = 0
Visible = False
OnClick = Button2Click
end
object button_Insert: TButton
Left = 224
Top = 8
Width = 105
Height = 25
Caption = '插入到数据库'
TabOrder = 1
OnClick = button_InsertClick
end
end
end
object TabSheet3: TTabSheet
Caption = '显示表单请求'
ImageIndex = 2
object Label4: TLabel
Left = 192
Top = 72
Width = 121
Height = 25
Alignment = taCenter
AutoSize = False
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clFuchsia
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label5: TLabel
Left = 192
Top = 104
Width = 121
Height = 25
Alignment = taCenter
AutoSize = False
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clFuchsia
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label_datadec: TLabel
Left = 200
Top = 192
Width = 121
Height = 25
Alignment = taCenter
AutoSize = False
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clFuchsia
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Label_dataTran: TLabel
Left = 200
Top = 168
Width = 121
Height = 25
Alignment = taCenter
AutoSize = False
Caption = '0'
Font.Charset = DEFAULT_CHARSET
Font.Color = clFuchsia
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
ParentFont = False
end
object Memo1: TMemo
Left = 0
Top = 0
Width = 209
Height = 277
Align = alLeft
ImeName = '中文(简体) - 搜狗拼音输入法'
Lines.Strings = (
'Memo1')
ScrollBars = ssVertical
TabOrder = 0
end
object Button4: TButton
Left = 224
Top = 128
Width = 57
Height = 25
Caption = '获取数据'
TabOrder = 1
OnClick = Button4Click
end
object Button5: TButton
Left = 232
Top = 216
Width = 57
Height = 25
Caption = '解析数据'
TabOrder = 2
OnClick = Button5Click
end
object DBGrid2: TDBGrid
Left = 320
Top = 0
Width = 241
Height = 277
Align = alRight
DataSource = DataSource1
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 3
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
TitleFont.Style = []
end
object ListBox1: TListBox
Left = 224
Top = 248
Width = 81
Height = 65
ImeName = '中文(简体) - 搜狗拼音输入法'
ItemHeight = 13
TabOrder = 4
end
object name_small: TEdit
Left = 216
Top = 16
Width = 89
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 5
Text = 'A000000'
end
object name_big: TEdit
Left = 216
Top = 48
Width = 89
Height = 21
ImeName = '中文(简体) - 搜狗拼音输入法'
TabOrder = 6
Text = 'A009999'
end
end
end
object IdHTTP1: TIdHTTP
MaxLineAction = maException
ReadTimeout = 0
Port = 8080
AllowCookies = True
ProxyParams.BasicAuthentication = False
ProxyParams.ProxyPort = 0
Request.ContentLength = -1
Request.ContentRangeEnd = 0
Request.ContentRangeStart = 0
Request.ContentType = 'text/html'
Request.Accept = 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'
Request.BasicAuthentication = False
Request.UserAgent = 'Mozilla/3.0 (compatible; Indy Library)'
HTTPOptions = [hoInProcessAuth, hoKeepOrigProtocol]
Left = 32
Top = 256
end
object DataSource1: TDataSource
AutoEdit = False
DataSet = ClientDataSet1
Left = 36
Top = 208
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
Left = 44
Top = 296
object ClientDataSet1name: TStringField
FieldName = 'name'
Size = 10
end
object ClientDataSet1teacher: TStringField
FieldName = 'teacher'
Size = 10
end
object ClientDataSet1classroom: TStringField
FieldName = 'classroom'
Size = 10
end
end
object IdTCPClient1: TIdTCPClient
MaxLineAction = maException
ReadTimeout = 0
Port = 0
Left = 440
Top = 192
end
end

 

---------Form结束----------------

posted on 2020-12-18 16:50  码农的笔记  阅读(508)  评论(0)    收藏  举报