' Client_API.BAS by John White (danilo_yoingco@yahoo.co.uk)
'
' Client_API.BAS uses WSA_ Asynchronous (Multi-Tasking) calls to
' communicate with a Server.BAS (or any server). I wrote it for two
' programmes to communicate with each other on the same machine.
' Allowing each to send the other small text commands, but at the same
' time both monitor their windows for Async messages. If you want to
' use this code for Internet/Network purposes you should change the
' IP Address and Port Number to suitable values. Client_API.BAS was an
' original conversion of my c code, which was a collection of Internet
' C Source Codes (the basic framework) updated with my own adaptation
' (instead of doing a straight loop I used a timer. I also allowed the
' Server and Client to be window async, as the original codes I look at
' were straight server/client codes).
'
' The code uses a Memory Buffer, as I find this the best way to deal with
' API calls, memory structures and Pointers in general.
'
' mem_Default      -  400 bytes for the WSADATA structure.
' mem_Default+400  -  1024 bytes for the hostEnt data.
' mem_Default+1424 -  16 bytes for the (Client) Sockaddr_in structure.
' mem_Default+1440 -  256 bytes for the Read/Receive Buffer.
' mem_Default+1696 -  256 bytes for the Write/Send Buffer.
' mem_Default+1952 -
'
' Note. Unlike my previous codes, which are complete, (printer.BAS,
'       Console.BAS, etc) Client_API.BAS is just the skeleton/framework
'       as I did not want to bog this example down with too much code.
'       I did not want to put off the Beginner - Hence why I put the
'       setup in one SUB (setup_Client) for example.
'
' Note: This code is using 2.2 of the Socket Library. I am now using
'       Windows 2000 Pro and am no longer writing for Windows 98SE.

$OPTIMIZE ON
$APPTYPE GUI
$TYPECHECK ON
$ESCAPECHARS ON

' Registry.
Const HKEY_LOCAL_MACHINE=&H80000002
Const KEY_ALL_ACCESS=&HF003F
Const ERROR_SUCCESS=0

' Memory.
Const GMEM_FIXED=0
Const GMEM_MOVEABLE=2
Const GMEM_ZEROINIT=64
Const GMEM_INVALID_HANDLE=&H8000

' Window.
Const WM_COMMAND=&H111
Const WM_CLOSE=16
Const WM_USER=1024

' Socket.
Const AF_INET=2
Const SOCK_STREAM=1
Const VERSION_1_1=257
Const VERSION_2_2=514
Const MAXGETHOSTSTRUCT=1024
Const SM_GETHOST=WM_USER+1
Const SM_ASYNC=WM_USER+2
Const FD_READ=1
Const FD_WRITE=2
Const FD_OOB=4
Const FD_ACCEPT=8
Const FD_CONNECT=16
Const FD_CLOSE=32
Const INADDR_ANY=&H00000000
Const IPPROTO_IP=0
Const IPPROTO_TCP=6
Const WSABASEERR=10000
Const WSAEWOULDBLOCK=(WSABASEERR+35)
Const SOCKET_ERROR=-1
Const INVALID_SOCKET=-1

Declare Function connect Lib "wsock32.dll" Alias "connect" (hsocket As Long, sockaddr As Long, saSize As Long) As Long
Declare Function closesocket Lib "wsock32.dll" Alias "closesocket" (hsocket As Long) As Long
Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal dest As LONG, ByVal source As LONG, ByVal numBytes As LONG)
Declare Function GetLastError Lib "kernel32.dll" Alias "GetLastError" () As Long
Declare Function GlobalAlloc Lib "kernel32.dll" Alias "GlobalAlloc" (flags As Long, numBytes As Long) As Long
Declare Function GlobalFree Lib "kernel32.dll" Alias "GlobalFree" (hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32.dll" Alias "GlobalLock" (hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32.dll" Alias "GlobalUnlock" (hMem As Long) As Long
Declare Function htonl Lib "wsock32.dll" Alias "htonl" (hbo As Long) As Long
Declare Function htons Lib "wsock32.dll" Alias "htons" (hbo As Word) As Word
Declare Function inet_addr Lib "wsock32.dll" Alias "inet_addr" (dottedAdr As String) As Long
Declare Function listen Lib "wsock32.dll" Alias "listen" (hsocket As Long, backlog As Long) As Long
Declare Function recv Lib "wsock32.dll" Alias "recv" (hsocket As Long, buffer As Long, buflen As Long, flags As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (rootKey As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (rootKey As Long, subKey As String, options As Long, access As Long, status As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (rootKey As Long, valueName As String, reserved As Long, valueType As Long, buffer As Long, bufsize As Long) As Long
Declare Function send Lib "wsock32.dll" Alias "send" (hsocket As Long, buffer As Long, buflen As Long, flags As Long) As Long
Declare Function socket Lib "wsock32.dll" Alias "socket" (af As Long, stype As Long, protocol As Long) As Long
Declare Function WSAAsyncGetHostByName Lib "wsock32.dll" Alias "WSAAsyncGetHostByName" (hwnd As Long, wMsg As Long, hostName As String, hostEnt As Long, heSize As Long) As Long
Declare Function WSAAsyncSelect Lib "wsock32.dll" Alias "WSAAsyncSelect" (hSocket As Long, hwnd As Long, wMsg As Long, bitmask As Long) As Long
Declare Function WSACleanup Lib "wsock32.dll" Alias "WSACleanup" () As Long
Declare Function WSAGetLastError Lib "wsock32.dll" Alias "WSAGetLastError" () As Long
Declare Function WSAStartup Lib "wsock32.dll" Alias "WSAStartup" (version As Word, wsaData As Long) As Long
Declare Sub window_Proc (Handle As Long, uMsg As Long, wParam As Long, lParam As Long)

' Socket Variables.
DIM key_handle AS LONG, host_handle AS LONG, timer0 AS QTIMER
DIM timer0_status AS BYTE
DIM hostName$ AS STRING, clientSocket AS LONG, susts AS BYTE
DIM asyncMsg AS LONG, bytesRead AS LONG

' Memory Variables.
DIM mem_Lock AS LONG, mem_Memory AS LONG, mem_Default AS LONG
DIM mem_Offset AS LONG, FLong AS LONG, FWord AS WORD, FByte AS BYTE
DIM FFour AS LONG

' Generic Variables.
DIM rtn AS LONG, rtnval AS LONG, stg$ AS STRING, slen AS LONG
DIM count AS LONG, window AS QForm

window.Center : window.WndProc=window_Proc
timer0.Enabled=0 : timer0.Interval=1000 : timer0_status=0
hostName$=STRING$(16,0)
susts=0

SUB UnLock_DefaultMemory
IF mem_Lock<>0 THEN
rtn=GlobalUnlock(mem_Lock)
IF ((rtn=0) AND (GetLastError()=0)) THEN
'MEM UNLOCKED
ELSE
'MEM NOT UNLOCK
END IF
END IF
END SUB

SUB Free_DefaultMemory
IF mem_Memory<>0 THEN
rtn=GlobalFree(mem_Memory)
IF rtn=0 THEN
'MEM FREED
ELSE
'MEM NOT FREED
END IF
END IF
END SUB

SUB Alloc_DefaultMemory(bufsize AS LONG)
mem_Lock=0
mem_Memory=0
mem_Default=0
mem_Memory=GlobalAlloc(GMEM_MOVEABLE OR GMEM_ZEROINIT, bufsize)
IF mem_Memory<>0 THEN
mem_Lock=GlobalLock(mem_Memory)
IF mem_Lock<>0 THEN
mem_Default=mem_Lock

END IF
END IF
END SUB

SUB do_ReadData
stg$=VarPtr$(mem_Default+1440) ' stg$ now holds the Read Buffer contents.
ShowMessage("Server Wrote: "+stg$)
IF stg$="Welcome Client 0" THEN
ShowMessage("How Are You, Server")
END IF
END SUB

SUB do_AsyncMsg(wParam As Long,lParam As Long)
asyncMsg=(lParam AND &H0000FFFF) ' WSAGETSELECTEVENT(lParam) MACRO.

SELECT CASE asyncMsg

CASE FD_CONNECT
ShowMessage("This Client has Connected")

CASE FD_WRITE
stg$="Hello Server"
rtn=send(clientSocket,VarPtr(stg$),LEN(stg$),0)

CASE FD_READ
bytesRead=recv(clientSocket,mem_Default+1440,256,0)
IF bytesRead=0 THEN
' Connection has Closed.
ELSEIF bytesRead=SOCKET_ERROR THEN
' error.
ELSE
do_ReadData
END IF

CASE FD_CLOSE
ShowMessage("Server has Closed")

CASE ELSE

END SELECT
END SUB

SUB setup_client(wParam As Long,lParam As Long)
IF wParam=host_handle THEN
rtn=(lParam AND &HFFFF0000) ' WSAGETASYNCERROR(lParam) MACRO.
IF rtn=0 THEN
' Here I have used the TCP protocol. If you do not want to use a
' particular protocol just use the IPPROTO_IP (default) protocol.
clientSocket=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP)
IF clientSocket<>INVALID_SOCKET THEN
rtn=WSAAsyncSelect(clientSocket,window.Handle,SM_ASYNC,FD_CONNECT OR FD_READ OR FD_WRITE OR FD_CLOSE)
IF rtn=0 THEN
' This is the SOCKADDR_IN structure (16 bytes) for the Client.
FWord=AF_INET
CopyMemory mem_Default+1424, VarPtr(FWord), 2 ' sin_family
FWord=htons(5000) ' Use Port 5000 - Change this to 110 etc for Internet.
CopyMemory mem_Default+1426, VarPtr(FWord), 2 ' sin_port
' sin_adr can be your IP address converted with inet_addr or it can be
' from the hostEnt structure. I am Currently trying to find a suitable
' way to extract the IP Address from hostEnt! Use inet_addr for now.
FLong=inet_addr("127.0.0.1") ' Default (your machine) IP Address.
CopyMemory mem_Default+1428, VarPtr(FLong), 4 ' sin_addr
rtn=connect(clientSocket,mem_Default+1424,16)
IF rtn=SOCKET_ERROR THEN
rtn=WSAGetLastError()
IF rtn<>WSAEWOULDBLOCK THEN
' error.
END IF
END IF
END IF
END IF
END IF
END IF
END SUB

SUB window_Proc(Handle As Integer,uMsg As DWord,wParam As Long,lParam As Long)

SELECT CASE uMsg

CASE WM_CLOSE
IF susts=1 THEN
' DO NOT call WSACleanup() etc from here - Allow this program to go
' to the end of the code to do its cleanup.

' Cleanup any remaining messages/Reads.
bytesRead=recv(clientSocket,mem_Default+1440,256,0)
WHILE ((bytesRead<>0) AND (bytesRead<>SOCKET_ERROR))
bytesRead=recv(clientSocket,mem_Default+1440,256,0)
WEND
closesocket(clientSocket)
END IF

CASE SM_GETHOST
setup_client(wParam,lParam)

CASE SM_ASYNC
do_AsyncMsg(wParam,lParam)

CASE ELSE

END SELECT

END SUB

' ------------------------------ Startup calls -------------------------

' Allocate a default buffer for Socket calls.
Alloc_DefaultMemory(3000)

' WSAStartup() MUST be called before doing any other Socket calls.
rtn=WSAStartup(VERSION_1_1,mem_Default)
IF rtn=0 THEN
' Check if version 2.2 of the socket library is available. The version
' numbers are just a WORD, with MSB = 2 (bit 1 - value 512) and LSB = 2
' (bit 1 - value 2). So the WORD has a value of 514 to represent 2.2
CopyMemory VarPtr(FWord), mem_Default, 2
IF FWord=VERSION_1_1 THEN
' This registry key opens the hostname key, which is just the Computer`s
' name that the client is residing on.
rtn=RegOpenKeyEx(HKEY_LOCAL_MACHINE,"System\\CurrentControlSet\\Services\\VxD\\MSTCP",0,KEY_ALL_ACCESS,VarPtr(key_Handle))
IF rtn=ERROR_SUCCESS THEN
rtnval=LEN(hostName$)
rtn=RegQueryValueEx(key_handle,"hostName",0,VarPtr(rtnval),VarPtr(hostName$),VarPtr(rtnval))
IF rtn=ERROR_SUCCESS THEN
' This gets the hostEnt structure, which gives details about the host.
host_handle=WSAAsyncGetHostByName(window.Handle,SM_GETHOST,hostName$,mem_Default+400,MAXGETHOSTSTRUCT)
IF host_handle<>0 THEN
susts=1 ' Success! StartUp STatuS is assigned value 1.
END IF
END IF
rtn=RegCloseKey(key_handle)
IF rtn=ERROR_SUCCESS THEN

ELSE
' Error
END IF
END IF

IF susts=1 THEN window.ShowModal

END IF
rtn=WSACleanup
IF rtn=SOCKET_ERROR THEN
' Error
END IF
END IF

UnLock_DefaultMemory
Free_DefaultMemory