PBMiner Sources TopWiz/winhttp/PB8/w

File: w_main.srw
Size: 14357
Date: Fri, 05 Jan 2018 12:47:03 +0100
$PBExportHeader$w_main.srw
forward
global type w_main from window
end type
type cb_posturl_file from commandbutton within w_main
end type
type cb_post_binary from commandbutton within w_main
end type
type cb_geturl_file from commandbutton within w_main
end type
type st_msg from statictext within w_main
end type
type cb_geturl_text from commandbutton within w_main
end type
type cb_post_text from commandbutton within w_main
end type
type mle_response from multilineedit within w_main
end type
type cb_get from commandbutton within w_main
end type
type cb_cancel from commandbutton within w_main
end type
end forward

global type w_main from window
integer width = 3195
integer height = 1708
boolean titlebar = true
string title = "WinHTTP"
boolean controlmenu = true
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
event ue_setwriteprogress pbm_custom01
cb_posturl_file cb_posturl_file
cb_post_binary cb_post_binary
cb_geturl_file cb_geturl_file
st_msg st_msg
cb_geturl_text cb_geturl_text
cb_post_text cb_post_text
mle_response mle_response
cb_get cb_get
cb_cancel cb_cancel
end type
global w_main w_main

type prototypes
Function long CreateFile ( &
   string lpFileName, &
   ulong dwDesiredAccess, &
   ulong dwShareMode, &
   ulong lpSecurityAttributes, &
   ulong dwCreationDisposition, &
   ulong dwFlagsAndAttributes, &
   ulong hTemplateFile &
   ) Library "kernel32.dll" Alias For "CreateFileA"

Function boolean CloseHandle ( &
   long hObject &
   ) Library "kernel32.dll"

Function boolean ReadFile ( &
   long hFile, &
   Ref blob lpBuffer, &
   ulong nNumberOfBytesToRead, &
   Ref ulong lpNumberOfBytesRead, &
   ulong lpOverlapped &
   ) Library "kernel32.dll"

Function boolean WriteFile ( &
   ulong hFile, &
   blob lpBuffer, &
   ulong nNumberOfBytesToWrite, &
   Ref ulong lpNumberOfBytesWritten, &
   ulong lpOverlapped &
   ) Library "kernel32.dll"

end prototypes

type variables
// constants for CreateFile API function
Constant Long INVALID_HANDLE_VALUE = -1
Constant ULong GENERIC_READ     = 2147483648
Constant ULong GENERIC_WRITE    = 1073741824
Constant ULong FILE_SHARE_READ  = 1
Constant ULong FILE_SHARE_WRITE = 2
Constant ULong CREATE_NEW        = 1
Constant ULong CREATE_ALWAYS     = 2
Constant ULong OPEN_EXISTING     = 3
Constant ULong OPEN_ALWAYS       = 4
Constant ULong TRUNCATE_EXISTING = 5

end variables

forward prototypes
public function boolean wf_writefile (string as_filename, blob ablob_filedata)
public function long wf_readfile (string as_filename, ref blob ablob_data)
end prototypes

event ue_setwriteprogress;// update write progress

String ls_msg

ls_msg = "Send Data " + &
         String(wparam / lparam, "#0%") + " complete."

st_msg.text = ls_msg

Yield()

end event

public function boolean wf_writefile (string as_filename, blob ablob_filedata);// write blob to file

ULong lul_file, lul_length, lul_written
Boolean lb_rtn

lul_length = Len(ablob_filedata)

// open file for write
lul_file = CreateFile(as_filename, GENERIC_WRITE, &
               FILE_SHARE_WRITE, 0, CREATE_ALWAYS, 0, 0)
If lul_file = INVALID_HANDLE_VALUE Then
   Return False
End If

// write file to disk
lb_rtn = WriteFile(lul_file, ablob_filedata, &
               lul_Length, lul_written, 0)

// close the file
CloseHandle(lul_file)

Return True

end function

public function long wf_readfile (string as_filename, ref blob ablob_data);// read a file from disk to a blob

ULong lul_bytes, lul_length
Long ll_hFile
Blob lblob_filedata
Boolean lb_result

// get file length
lul_length = FileLength(as_filename)

// open file for read
ll_hFile = CreateFile(as_filename, GENERIC_READ, &
               FILE_SHARE_READ, 0, OPEN_EXISTING, 0, 0)
If ll_hFile = INVALID_HANDLE_VALUE Then
   Return -1
End If

// read the entire file contents in one shot
lblob_filedata = Blob(Space(lul_length))
lb_result = ReadFile(ll_hFile, lblob_filedata, &
               lul_length, lul_bytes, 0)
ablob_data = BlobMid(lblob_filedata, 1, lul_length)

// close the file
CloseHandle(ll_hFile)

Return Len(ablob_data)

end function

on w_main.create
this.cb_posturl_file=create cb_posturl_file
this.cb_post_binary=create cb_post_binary
this.cb_geturl_file=create cb_geturl_file
this.st_msg=create st_msg
this.cb_geturl_text=create cb_geturl_text
this.cb_post_text=create cb_post_text
this.mle_response=create mle_response
this.cb_get=create cb_get
this.cb_cancel=create cb_cancel
this.Control[]={this.cb_posturl_file,&
this.cb_post_binary,&
this.cb_geturl_file,&
this.st_msg,&
this.cb_geturl_text,&
this.cb_post_text,&
this.mle_response,&
this.cb_get,&
this.cb_cancel}
end on

on w_main.destroy
destroy(this.cb_posturl_file)
destroy(this.cb_post_binary)
destroy(this.cb_geturl_file)
destroy(this.st_msg)
destroy(this.cb_geturl_text)
destroy(this.cb_post_text)
destroy(this.mle_response)
destroy(this.cb_get)
destroy(this.cb_cancel)
end on

type cb_posturl_file from commandbutton within w_main
integer x = 2706
integer y = 832
integer width = 407
integer height = 100
integer taborder = 70
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "PostURL File"
end type

event clicked;n_winhttp ln_http
String ls_URL, ls_title, ls_pathname, ls_filename
String ls_filter, ls_data, ls_mimetype
Blob lblob_data, lblob_response
Integer li_rc
ULong lul_length

ls_title  = "Select a File"
ls_filter = "Target Files (*.pbt),*.pbt"

li_rc = GetFileOpenName(ls_title, ls_pathname, &
                     ls_filename, "", ls_filter)
If li_rc < 1 Then
   Return
End If

lul_length = wf_ReadFile(ls_pathname, lblob_data)

SetPointer(HourGlass!)

ln_http.SetWriteProgress(Handle(Parent), 1024)

ls_URL  = "http://www.topwizprogramming.com"
ls_URL += "/winhttp/roland_post.asp?filename=" + ls_filename

ls_mimetype = ln_http.GetMIMEType(ls_pathname, lblob_data)

lul_length = ln_http.PostURL(ls_URL, &
         lblob_data, ls_mimetype, lblob_response)
If lul_length > 0 Then
   mle_response.text = String(lblob_response)
   st_msg.text = "Post Complete in " + &
      String(ln_http.Elapsed, "#,##0.####") + " seconds."
Else
   MessageBox("PostURL Error #" + &
               String(ln_http.LastErrorNum), &
               ln_http.LastErrorText, StopSign!)
End If

end event

type cb_post_binary from commandbutton within w_main
integer x = 2706
integer y = 672
integer width = 407
integer height = 100
integer taborder = 60
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "Post Binary File"
end type

event clicked;// example HTTP POST

n_winhttp ln_http
String ls_URL, ls_title, ls_pathname, ls_filename
String ls_filter, ls_mimetype
ULong lul_length
Blob lblob_data
Integer li_rc

ls_title  = "Select a File"
ls_filter = "Adobe Acrobat Files (*.pdf),*.pdf"

li_rc = GetFileOpenName(ls_title, ls_pathname, &
                     ls_filename, "", ls_filter)
If li_rc < 1 Then
   Return
End If

lul_length = wf_ReadFile(ls_pathname, lblob_data)

SetPointer(HourGlass!)

ln_http.SetWriteProgress(Handle(Parent), 1024)

ls_URL  = "http://www.topwizprogramming.com"
ls_URL += "/winhttp/roland_post.asp?filename=" + ls_filename

ls_mimetype = ln_http.GetMIMEType(ls_pathname, lblob_data)

ln_http.Open("POST", ls_URL)
ln_http.SetRequestHeader("Content-Length", String(lul_length))
ln_http.SetRequestHeader("Content-Type", ls_mimetype)

lul_length = ln_http.Send(lblob_data)
If lul_length > 0 Then
   mle_response.text = ln_http.ResponseText
   st_msg.text = "Post Complete in " + &
      String(ln_http.Elapsed, "#,##0.####") + " seconds."
Else
   MessageBox("HTTP Post Error #" + &
               String(ln_http.LastErrorNum), &
               ln_http.LastErrorText, StopSign!)
End If

end event

type cb_geturl_file from commandbutton within w_main
integer x = 2706
integer y = 352
integer width = 407
integer height = 100
integer taborder = 40
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "GetURL File"
end type

event clicked;// example HTTP GET in the style of the GetURL function

n_winhttp ln_http
Blob lblob_data
String ls_URL, ls_pathname, ls_filename
ULong lul_length
Integer li_rc

SetPointer(HourGlass!)

// get a binary file from the server
ls_pathname = "payflowgateway_guide.pdf"
ls_URL = "http://www.topwizprogramming.com/winhttp/" + ls_pathname

lul_length = ln_http.GetURL(ls_URL, lblob_data)
If lul_length > 0 Then
   st_msg.text = "GetURL returned " + &
      String(Len(lblob_data)) + " characters in " + &
      String(ln_http.Elapsed, "#,##0.####") + " seconds."
   li_rc = GetFileSaveName("Save File", &
            ls_pathname, ls_filename, "pdf", &
            "Adobe Acrobat Files (*.pdf), *.pdf")
   If li_rc = 1 Then
      // save the returned blob to disk
      wf_WriteFile(ls_pathname, lblob_data)
   End If
Else
   MessageBox("GetURL Error #" + &
               String(ln_http.LastErrorNum), &
               ln_http.LastErrorText, StopSign!)
End If

end event

type st_msg from statictext within w_main
integer x = 37
integer y = 1504
integer width = 2601
integer height = 68
integer textsize = -10
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
long textcolor = 33554432
long backcolor = 67108864
boolean focusrectangle = false
end type

type cb_geturl_text from commandbutton within w_main
integer x = 2706
integer y = 192
integer width = 407
integer height = 100
integer taborder = 30
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "GetURL Text"
end type

event clicked;// example HTTP GET in the style of the GetURL function

n_winhttp ln_http
ULong lul_length
Blob lblob_data
String ls_URL

SetPointer(HourGlass!)

// get a text file from the server
ls_URL = "http://www.topwizprogramming.com/about.html"

lul_length = ln_http.GetURL(ls_URL, lblob_data)
If lul_length > 0 Then
   st_msg.text = "GetURL returned " + &
      String(Len(lblob_data)) + " characters in " + &
      String(ln_http.Elapsed, "#,##0.####") + " seconds."
   mle_response.text = String(lblob_data)
Else
   MessageBox("GetURL Error #" + &
               String(ln_http.LastErrorNum), &
               ln_http.LastErrorText, StopSign!)
End If

end event

type cb_post_text from commandbutton within w_main
integer x = 2706
integer y = 512
integer width = 407
integer height = 100
integer taborder = 50
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "Post Text File"
end type

event clicked;// example HTTP POST

n_winhttp ln_http
String ls_URL, ls_title, ls_pathname, ls_filename
String ls_filter, ls_mimetype, ls_data
Integer li_rc, li_fnum
Blob lblob_data
ULong lul_length

ls_title  = "Select a File"
ls_filter = "Target Files (*.pbt),*.pbt"

li_rc = GetFileOpenName(ls_title, ls_pathname, &
                     ls_filename, "", ls_filter)
If li_rc < 1 Then
   Return
End If

lul_length = wf_ReadFile(ls_pathname, lblob_data)
ls_data = String(lblob_data)

SetPointer(HourGlass!)

ln_http.SetWriteProgress(Handle(Parent), 1024)

ls_URL  = "http://www.topwizprogramming.com"
ls_URL += "/winhttp/roland_post.asp?filename=" + ls_filename

ls_mimetype = ln_http.GetMIMEType(ls_pathname, ls_data)

ln_http.Open("POST", ls_URL)
ln_http.SetRequestHeader("Content-Length", String(lul_length))
ln_http.SetRequestHeader("Content-Type", ls_mimetype)

lul_length = ln_http.Send(ls_data)
If lul_length > 0 Then
   mle_response.text = ln_http.ResponseText
   st_msg.text = "Post Complete in " + &
      String(ln_http.Elapsed, "#,##0.####") + " seconds."
Else
   MessageBox("HTTP Post Error #" + &
               String(ln_http.LastErrorNum), &
               ln_http.LastErrorText, StopSign!)
End If

end event

type mle_response from multilineedit within w_main
integer x = 37
integer y = 32
integer width = 2601
integer height = 1444
integer taborder = 10
integer textsize = -9
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = fixed!
fontfamily fontfamily = modern!
string facename = "Fixedsys"
long textcolor = 33554432
boolean vscrollbar = true
boolean autovscroll = true
boolean displayonly = true
borderstyle borderstyle = stylelowered!
end type

type cb_get from commandbutton within w_main
integer x = 2706
integer y = 32
integer width = 407
integer height = 100
integer taborder = 20
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "Get"
end type

event clicked;// example HTTP Get in the style of XMLHttpRequest

n_winhttp ln_http
ULong lul_length
String ls_URL

SetPointer(HourGlass!)

// get a text file from the server
ls_URL = "http://www.topwizprogramming.com/about.html"

If ln_http.Open("GET", ls_URL) Then
   lul_length = ln_http.Send()
   If lul_length > 0 Then
      st_msg.text = "Get returned " + &
         String(lul_length) + " characters in " + &
         String(ln_http.Elapsed, "#,##0.####") + " seconds."
      mle_response.text = ln_http.ResponseText
   Else
      MessageBox("Send Error #" + &
                  String(ln_http.LastErrorNum), &
                  ln_http.LastErrorText, StopSign!)
   End If
Else
   MessageBox("Open Error #" + &
               String(ln_http.LastErrorNum), &
               ln_http.LastErrorText, StopSign!)
End If

end event

type cb_cancel from commandbutton within w_main
integer x = 2706
integer y = 1472
integer width = 407
integer height = 100
integer taborder = 70
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "Cancel"
boolean cancel = true
end type

event clicked;Close(Parent)

end event
window w_main(srw)
- Properties
- External Functions
- Instance Variables
- create
- destroy
- ue_setwriteprogress
- wf_readfile (string as_filename, ref blob ablob_data) returns long
- wf_writefile (string as_filename, blob ablob_filedata) returns boolean
- commandbutton cb_posturl_file
  - Properties
  - clicked
- commandbutton cb_post_binary
  - Properties
  - clicked
- commandbutton cb_geturl_file
  - Properties
  - clicked
- statictext st_msg
  - Properties
- commandbutton cb_geturl_text
  - Properties
  - clicked
- commandbutton cb_post_text
  - Properties
  - clicked
- multilineedit mle_response
  - Properties
- commandbutton cb_get
  - Properties
  - clicked
- commandbutton cb_cancel
  - Properties
  - clicked