Blog de Tecnologia desenvolvido por Thiago Campos Pereira

terça-feira, janeiro 04, 2011

PowerBuilder – Enviando e-mail por SMTP - Parte 1/ 4

Abaixo mais uma solução para envio de e-mail pelo PowerBuilder que compartilhada pelo Daniel Carvalho Ferreira

1) Criar o Objeto n_winsock (abaixo o export do objeto)

$PBExportHeader$n_winsock.sru

$PBExportComments$Winsock functions

forward

global type n_winsock from nonvisualobject

end type

type hostent from structure within n_winsock

end type

type in_addr from structure within n_winsock

end type

type sockaddr from structure within n_winsock

end type

type wsadata from structure within n_winsock

end type

type fd_set from structure within n_winsock

end type

type timeval from structure within n_winsock

end type

end forward

type hostent from structure

unsignedlong h_name

unsignedlong h_aliases

integer h_addrtype

integer h_length

unsignedlong h_addr_list

end type

type in_addr from structure

unsignedlong s_addr

end type

type sockaddr from structure

integer sin_family

unsignedinteger sin_port

in_addr sin_addr

character sin_zero[8]

end type

type wsadata from structure

unsignedinteger wversion

unsignedinteger whighversion

character szdescription[257]

character szsystemstatus[129]

unsignedinteger imaxsockets

unsignedinteger imaxudpdg

unsignedlong lpvenderinfo

end type

type fd_set from structure

unsignedlong fd_count

unsignedlong fd_array[]

end type

type timeval from structure

unsignedlong tv_sec

unsignedlong tv_usec

end type

global type n_winsock from nonvisualobject autoinstantiate

end type

type prototypes

Private:

Subroutine CopyMemoryIP ( &

Ref structure Destination, &

ulong Source, &

long Length &

) Library "kernel32.dll" Alias For "RtlMoveMemory"

Subroutine CopyMemoryIP ( &

Ref blob Destination, &

ulong Source, &

long Length &

) Library "kernel32.dll" Alias For "RtlMoveMemory"

Subroutine CopyMemoryIP ( &

Ref ulong Destination, &

ulong Source, &

long Length &

) Library "kernel32.dll" Alias For "RtlMoveMemory"

Function boolean CryptBinaryToString ( &

Blob pbBinary, &

ulong cbBinary, &

ulong dwFlags, &

Ref string pszString, &

Ref ulong pcchString &

) Library "crypt32.dll" Alias For "CryptBinaryToStringW"

Function boolean CryptStringToBinary ( &

string pszString, &

ulong cchString, &

ulong dwFlags, &

Ref blob pbBinary, &

Ref ulong pcbBinary, &

Ref ulong pdwSkip, &

Ref ulong pdwFlags &

) Library "crypt32.dll" Alias For "CryptStringToBinaryW"

Function ulong FormatMessage( &

ulong dwFlags, &

ulong lpSource, &

ulong dwMessageId, &

ulong dwLanguageId, &

Ref string lpBuffer, &

ulong nSize, &

ulong Arguments &

) Library "kernel32.dll" Alias For "FormatMessageW"

Function ulong RegisterEventSource ( &

ulong lpUNCServerName, &

string lpSourceName &

) Library "advapi32.dll" Alias For "RegisterEventSourceW"

Function boolean ReportEvent ( &

ulong hEventLog, &

uint wType, &

uint wCategory, &

ulong dwEventID, &

ulong lpUserSid, &

uint wNumStrings, &

ulong dwDataSize, &

string lpStrings[], &

ulong lpRawData &

) Library "advapi32.dll" Alias For "ReportEventW"

Function boolean DeregisterEventSource ( &

ref ulong hEventLog &

) Library "advapi32.dll"

Function ulong WNetGetUser ( &

string lpname, &

Ref string lpusername, &

Ref ulong buflen &

) Library "mpr.dll" Alias For "WNetGetUserW"

// Winsock Functions

Function ulong accept ( &

ulong socket, &

Ref sockaddr addr, &

Ref long addrlen &

) Library "ws2_32.dll" Alias For "accept;Ansi"

Function long bind ( &

ulong socket, &

sockaddr name, &

long namelen &

) Library "ws2_32.dll"

Function long closesocket ( &

ulong socket &

) Library "ws2_32.dll"

Function long connect_ws ( &

ulong socket, &

sockaddr name, &

long namelen &

) Library "ws2_32.dll" Alias For "connect"

Function ulong gethostbyaddr ( &

Ref ulong addr, &

long len, &

long htype &

) Library "ws2_32.dll"

Function long gethostname ( &

Ref string name, &

long namelen &

) Library "ws2_32.dll" Alias For "gethostname;Ansi"

Function ulong gethostbyname ( &

string name &

) Library "ws2_32.dll" Alias For "gethostbyname;Ansi"

Function long getpeername ( &

ulong socket, &

Ref sockaddr name, &

Ref long namelen &

) Library "ws2_32.dll" Alias For "getpeername;Ansi"

Function long getsockopt ( &

ulong socket, &

long level, &

long optname, &

ref long optval, &

ref long optlen &

) Library "ws2_32.dll"

Function ulong htonl ( &

ulong hostulong &

) Library "ws2_32.dll"

Function uint htons ( &

uint hostshort &

) Library "ws2_32.dll"

Function ulong inet_addr ( &

string cp &

) Library "ws2_32.dll" Alias For "inet_addr;Ansi"

Function string inet_ntoa ( &

ulong sin_addr &

) Library "ws2_32.dll"

Function long ioctlsocket ( &

ulong socket, &

ulong cmd, &

ref ulong argp &

) Library "ws2_32.dll"

Function ulong ntohl ( &

ulong netlong &

) Library "ws2_32.dll"

Function long listen ( &

ulong socket, &

long backlog &

) Library "ws2_32.dll"

Function long recv ( &

ulong socket, &

Ref blob buf, &

long len, &

long flags &

) Library "ws2_32.dll"

Function long recvfrom ( &

ulong socket, &

Ref blob buf, &

long len, &

long flags, &

Ref sockaddr fromaddr, &

Ref long fromlen &

) Library "ws2_32.dll"

Function long select_ws ( &

long socket, &

Ref fd_set readfds, &

Ref fd_set writefds, &

Ref fd_set exceptfds, &

timeval timeout &

) Library "ws2_32.dll" Alias For "select"

Function long send ( &

ulong socket, &

Ref blob buf, &

long len, &

long flags &

) Library "ws2_32.dll"

Function long sendto ( &

ulong socket, &

blob buf, &

long len, &

long flags, &

sockaddr toaddr, &

long tolen &

) Library "ws2_32.dll"

Function long setsockopt ( &

ulong socket, &

long level, &

long optname, &

Ref boolean optval, &

Ref long optlen &

) Library "ws2_32.dll"

Function ulong socket ( &

long af, &

long ttype, &

long protocol &

) Library "ws2_32.dll"

Function long WSACleanup ( &

) Library "ws2_32.dll"

Function long WSAGetLastError ( &

) Library "ws2_32.dll"

Subroutine WSASetLastError ( &

long iErrorNum &

) Library "ws2_32.dll"

Function long WSAStartup ( &

ulong wVersionRequested, &

Ref WSADATA lpWSAData &

) Library "ws2_32.dll"

Function long WSAAsyncSelect ( &

ulong socket, &

long hWnd, &

ulong wMsg, &

long lEvent &

) Library "ws2_32.dll"

Function long WSAAddressToString ( &

sockaddr lpsaAddress, &

long dwAddressLength, &

ulong lpProtocolInfo, &

Ref string lpszAddressString, &

Ref long lpdwAddressStringLength &

) Library "ws2_32.dll" Alias For "WSAAddressToStringW"

end prototypes

type variables

Private:

WSADATA istr_wsadata

Boolean ib_initialized = False

Boolean ib_send_unicode = True

Boolean ib_recv_unicode = True

String is_lasterror

Public:

Constant ULong INVALID_SOCKET = 4294967295

Constant ULong INADDR_ANY = 0

Constant ULong CRYPT_STRING_BASE64 = 1

Constant Long SOCKET_ERROR = -1

Constant Long MAXGETSOCKADDRSTRUCT = 16

Constant Long AF_INET = 2

Constant Long SOMAXCONN = 2147483647

Constant Long SOCK_STREAM = 1

Constant Long SOCK_DGRAM = 2

Constant Long IPPROTO_TCP = 6

Constant Long IPPROTO_UDP = 17

Constant Long FD_READ = 1

Constant Long FD_WRITE = 2

Constant Long FD_OOB = 4

Constant Long FD_ACCEPT = 8

Constant Long FD_CONNECT = 10

Constant Long FD_CLOSE = 32

Constant Integer iERROR = 1

Constant Integer iWARN = 2

Constant Integer iINFO = 4

end variables

forward prototypes

public function unsignedlong of_accept (unsignedlong aul_socket)

public function boolean of_cleanup ()

public function boolean of_close (ref unsignedlong aul_socket)

public function unsignedlong of_connect (string as_hostname, unsignedinteger aui_port)

public function unsignedlong of_connect (string as_hostname, unsignedinteger aui_port, unsignedlong aul_seconds)

public function blob of_decode64 (string as_encoded)

public function string of_encode64 (blob ablob_data)

public function string of_encode64 (string as_data)

public subroutine of_eventlog (integer ai_msglevel, string as_msgtext)

public function string of_getdescription ()

public function string of_gethostname ()

public function string of_gethostname (string as_ipaddress)

public function string of_getipaddress (string as_hostname)

public function string of_getlasterror ()

public function string of_getpeername (unsignedlong aul_socket)

public function long of_getsockopt (unsignedlong aul_socket, string as_optname)

public function string of_getuserid ()

public function boolean of_ioctlsocket (unsignedlong aul_socket, string as_cmdname, ref unsignedlong aul_argp)

public subroutine of_jaguarlog (integer ai_msglevel, string as_msgtext)

public function unsignedlong of_listen (unsignedinteger aui_port)

public function unsignedlong of_listen (unsignedinteger aui_port, long al_handle, integer ai_event)

public subroutine of_messagebox (integer ai_msglevel, string as_msgtext)

public function long of_parse (string as_text, string as_sep, ref string as_array[])

public function boolean of_recv (unsignedlong aul_socket, ref blob ablob_data)

public function boolean of_recv (unsignedlong aul_socket, ref string as_data)

public function boolean of_recvfrom (unsignedinteger aui_port, ref blob ablob_data, ref string as_ipaddress)

public function boolean of_recvfrom (unsignedinteger aui_port, ref string as_data, ref string as_ipaddress)

public function boolean of_send (unsignedlong aul_socket, blob ablob_data)

public function boolean of_send (unsignedlong aul_socket, string as_data)

public function boolean of_sendto (string as_ipaddress, unsignedinteger aui_port, blob ablob_data)

public function boolean of_sendto (string as_ipaddress, unsignedinteger aui_port, string as_data)

public function boolean of_setblockingmode (unsignedlong aul_socket, boolean ab_blocking)

public subroutine of_setlasterror (string as_lasterror)

public function boolean of_setsockopt (unsignedlong aul_socket, string as_optname, boolean ab_optvalue)

public subroutine of_setunicode (boolean ab_send, boolean ab_recv)

public function boolean of_startup ()

end prototypes

public function unsignedlong of_accept (unsignedlong aul_socket);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Accept

// PURPOSE: This function permits an incoming connection

// attempt on a socket.

// ARGUMENTS: aul_socket - Open socket

// RETURN: 0 = Error

// >0 = Success ( a valid socket )

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

SOCKADDR lstr_sockaddr

Long lul_socket

Long ll_length

ll_length = MAXGETSOCKADDRSTRUCT

lstr_sockaddr.sin_zero[8] = ""

lul_socket = accept(aul_socket, lstr_sockaddr, ll_length)

If lul_socket = INVALID_SOCKET Then

Return 0

End If

Return lul_socket

end function

public function boolean of_cleanup ();// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Cleanup

// PURPOSE: This function terminates use of the socket library.

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

If Not ib_initialized Then

If WSACleanup() = 0 Then

ib_initialized = False

Else

Return False

End If

Return True

end function

public function boolean of_close (ref unsignedlong aul_socket);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Close

// PURPOSE: This function closes an open socket.

// ARGUMENTS: aul_socket - Open socket

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Long ll_rc

If aul_socket <> 0 Then

ll_rc = closesocket(aul_socket)

If ll_rc = 0 Then

aul_socket = 0

Else

Return False

End If

Return True

end function

public function unsignedlong of_connect (string as_hostname, unsignedinteger aui_port);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Connect

// PURPOSE: This function opens a socket for sending data.

// ARGUMENTS: as_hostname - Hostname

// aui_port - Port

// RETURN: 0 = Error

// >0 = Success ( a valid socket )

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// 09/16/2010 RolandS Changed Port to unsignedinteger

// 09/16/2010 RolandS Changed to feed new of_Connect with Timeout argument.

// -----------------------------------------------------------------------------

Return of_Connect(as_hostname, aui_port, 0)

end function

public function unsignedlong of_connect (string as_hostname, unsignedinteger aui_port, unsignedlong aul_seconds);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Connect

// PURPOSE: This function opens a socket for sending data. If a Timeout

// value is given, it is used to wait for the connection.

// ARGUMENTS: as_hostname - Hostname

// aui_port - Port

// aul_seconds - Timeout in seconds

// RETURN: 0 = Error

// >0 = Success ( a valid socket )

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// 09/16/2010 RolandS Added Timeout processing

// 09/16/2010 RolandS Changed Port to unsignedinteger

// -----------------------------------------------------------------------------

HOSTENT lstr_hostent

SOCKADDR lstr_sockaddr

TIMEVAL lstr_timeval

FD_SET lstr_read, lstr_write, lstr_except

ULong lul_socket, lul_ptr, lul_ipaddr

Long ll_rc

// get information about host

lul_ptr = gethostbyname(as_hostname)

If lul_ptr > 0 Then

// initialize the SOCKADDR structure

CopyMemoryIp(lstr_hostent, lul_ptr, MAXGETSOCKADDRSTRUCT)

CopyMemoryIp(lul_ipaddr, lstr_hostent.h_Addr_List, lstr_hostent.h_Length)

CopyMemoryIp(lstr_sockaddr.sin_addr, lul_ipaddr, lstr_hostent.h_Length)

lstr_sockaddr.sin_family = AF_INET

lstr_sockaddr.sin_port = htons(aui_port)

// create socket

lul_socket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

If lul_socket = INVALID_SOCKET Then

lul_socket = 0

Else

If aul_seconds = 0 Then

// connect on the socket

ll_rc = connect_ws(lul_socket, lstr_sockaddr, MAXGETSOCKADDRSTRUCT)

If ll_rc = SOCKET_ERROR Then

// some error occurred

of_SetLastError(of_GetLastError())

of_Close(lul_socket)

End if

Else

// make the socket non blocking

of_SetBlockingMode(lul_socket, False)

// attempt to connect on the socket

ll_rc = connect_ws(lul_socket, lstr_sockaddr, MAXGETSOCKADDRSTRUCT)

If ll_rc = SOCKET_ERROR Then

// initialize the structures

lstr_timeval.tv_sec = aul_seconds

lstr_write.fd_count = 1

lstr_write.fd_array[1] = lul_socket

// wait for the timeout

ll_rc = select_ws(0, lstr_read, lstr_write, lstr_except, lstr_timeval)

choose case ll_rc

case 0

// the timeout expired

of_SetLastError("The connection attempt timed out.")

of_Close(lul_socket)

case SOCKET_ERROR

// some error occurred

of_SetLastError(of_GetLastError())

of_Close(lul_socket)

case else

// the connection was made so make the socket blocking

of_SetBlockingMode(lul_socket, True)

end choose

End if

End If

Else

lul_socket = 0

End If

Return lul_socket

end function

public function blob of_decode64 (string as_encoded);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Decode64

// PURPOSE: This function converts a Base64 encoded string to binary.

// Note: Requires Windows XP or Server 2003

// ARGUMENTS: as_encoded - String containing encoded data

// RETURN: Blob containing decoded data

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblob_data

ULong lul_len, lul_buflen, lul_skip, lul_pflags

Boolean lb_rtn

lul_len = Len(as_encoded)

lul_buflen = lul_len

lblob_data = Blob(Space(lul_len))

lb_rtn = CryptStringToBinary(as_encoded, &

lul_len, CRYPT_STRING_BASE64, lblob_data, &

lul_buflen, lul_skip, lul_pflags)

Return BlobMid(lblob_data, 1, lul_buflen)

end function

public function string of_encode64 (blob ablob_data);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Encode64

// PURPOSE: This function converts binary data to a Base64 encoded string.

// Note: Requires Windows XP or Server 2003

// ARGUMENTS: ablob_data - Blob containing data

// RETURN: String containing encoded data

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// 09/27/2010 RolandS Changed to remove trailing CRLF characters

// -----------------------------------------------------------------------------

String ls_encoded

ULong lul_len, lul_buflen

Boolean lb_rtn

lul_len = Len(ablob_data)

lul_buflen = lul_len * 3

ls_encoded = Space(lul_buflen)

lb_rtn = CryptBinaryToString(ablob_data, lul_len, &

CRYPT_STRING_BASE64, ls_encoded, lul_buflen)

If lb_rtn Then

ls_encoded = Left(ls_encoded, lul_buflen - 2)

Else

SetNull(ls_encoded)

End If

Return ls_encoded

end function

public function string of_encode64 (string as_data);// -----------------------------------------------------------------------------

// SCRIPT: n_smtp.of_Encode64

// PURPOSE: This function converts string to blob and

// calls ancestor function.

// ARGUMENTS: as_data - String containing data

// RETURN: String containing encoded data

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 09/27/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Return of_Encode64(Blob(as_data, EncodingAnsi!))

end function

public subroutine of_eventlog (integer ai_msglevel, string as_msgtext);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_EventLog

// PURPOSE: This function writes a message to the Event Log.

// ARGUMENTS: ai_msglevel - The level of message importance

// as_msgtext - The text of the message

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

ULong lul_EventSource

String ls_errmsg[]

ls_errmsg[1] = as_msgtext

lul_EventSource = RegisterEventSource(0, this.ClassName())

If lul_EventSource > 0 Then

ReportEvent(lul_EventSource, ai_msglevel, &

0, 0, 0, UpperBound(ls_errmsg), 0, ls_errmsg, 0)

DeregisterEventSource(lul_EventSource)

End If

end subroutine

public function string of_getdescription ();// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_GetDescription

// PURPOSE: This function returns the winsock description.

// RETURN: String containing a description of the

// winsock library.

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblob_desc

lblob_desc = Blob(istr_wsadata.szDescription)

Return String(lblob_desc, EncodingAnsi!)

end function

public function string of_gethostname ();// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_GetHostName

// PURPOSE: This function retrieves the standard host name

// for the local computer.

// RETURN: Host name

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

String ls_hostname, ls_errmsg

Long ll_rc, ll_namelen

ll_namelen = 50

ls_hostname = Space(ll_namelen)

ll_rc = gethostname(ls_hostname, ll_namelen)

If ll_rc = SOCKET_ERROR Then

SetNull(ls_hostname)

End If

Return ls_hostname

end function

public function string of_gethostname (string as_ipaddress);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_GetHostName

// PURPOSE: This function finds the host name that corresponds to the

// specified IP Address.

// ARGUMENTS: as_ipaddress - IP Address of a server

// RETURN: IP Address

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

String ls_hostname

ULong lul_address, lul_ptr

Blob lblb_host

HOSTENT lstr_host

lul_address = inet_addr(as_ipaddress)

If lul_address > 0 Then

// get information about host

lul_ptr = gethostbyaddr(lul_address, 4, AF_INET)

If lul_ptr > 0 Then

// copy structure to local structure

CopyMemoryIP(lstr_host, lul_ptr, 16)

// copy ipaddress to local blob

lblb_host = Blob(Space(250), EncodingAnsi!)

CopyMemoryIP(lblb_host, lstr_host.h_name, 250)

ls_hostname = String(lblb_host, EncodingAnsi!)

Else

SetNull(ls_hostname)

End If

Else

SetNull(ls_hostname)

End If

Return ls_hostname

end function

public function string of_getipaddress (string as_hostname);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_GetIPAddress

// PURPOSE: This function finds the IP address for the

// specified host name.

// ARGUMENTS: as_hostname - host name of a server

// RETURN: IP Address

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

String ls_ipaddress

HOSTENT lstr_host

ULong lul_ptr, lul_ipaddr

IN_ADDR lstr_addr

// get information about host

lul_ptr = gethostbyname(as_hostname)

If lul_ptr > 0 Then

// copy structure to local structure

CopyMemoryIP(lstr_host, lul_ptr, 16)

// get memory address where ipaddress is located

CopyMemoryIP(lul_ipaddr, lstr_host.h_addr_list, 4)

CopyMemoryIP(lstr_addr, lul_ipaddr, 4)

ls_ipaddress = String(Blob(inet_ntoa(lstr_addr.s_addr)), EncodingAnsi!)

Else

SetNull(ls_ipaddress)

End If

Return ls_ipaddress

end function

public function string of_getlasterror ();// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_GetLastError

// PURPOSE: This function returns the message text for

// the most recent Winsock error.

// RETURN: Error message

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// 09/03/2010 RolandS Changed 'if' to 'case' adding is_lasterror handling

// -----------------------------------------------------------------------------

Constant ULong FORMAT_MESSAGE_FROM_SYSTEM = 4096

Constant ULong LANG_NEUTRAL = 0

String ls_errmsg

Long ll_error

ll_error = WSAGetLastError()

choose case ll_error

case 0

If is_lasterror = "" Then

ls_errmsg = "An unknown error has occurred!"

Else

ls_errmsg = is_lasterror

End If

case else

ls_errmsg = Space(250)

FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, &

ll_error, LANG_NEUTRAL, ls_errmsg, Len(ls_errmsg), 0)

end choose

WSASetLastError(0)

Return Trim(ls_errmsg)

end function

public function string of_getpeername (unsignedlong aul_socket);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_GetPeerName

// PURPOSE: This function returns the IP Address of the computer on the

// other end of the socket.

// ARGUMENTS: aul_socket - Open socket

// RETURN: IP Address of Peer

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

SOCKADDR lstr_sockaddr

Long ll_length, ll_rtn, ll_pos, ll_strlen

String ls_ipaddress

ll_length = MAXGETSOCKADDRSTRUCT

lstr_sockaddr.sin_zero[8] = ""

ll_rtn = getpeername(aul_socket, lstr_sockaddr, ll_length)

If ll_rtn <> 0 Then

SetNull(ls_ipaddress)

Return ls_ipaddress

End If

// get the ip address in readable format

ll_strlen = 20

ls_ipaddress = Space(ll_strlen)

ll_rtn = WSAAddressToString(lstr_sockaddr, &

ll_length, 0, ls_ipaddress, ll_strlen)

If ll_rtn <> 0 Then

SetNull(ls_ipaddress)

Return ls_ipaddress

End If

// separate address & port

ll_pos = Pos(ls_ipaddress, ":")

ls_ipaddress = Left(ls_ipaddress, ll_pos - 1)

Return ls_ipaddress

end function

public function long of_getsockopt (unsignedlong aul_socket, string as_optname);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_GetSockOpt

// PURPOSE: This function returns options that use long datatype.

// ARGUMENTS: aul_socket - Open socket

// as_optname - Option name

// RETURN: Option value

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Constant Long SOL_SOCKET = 65535

Long ll_optname, ll_optvalue, ll_buflen

ll_buflen = 4

choose case Upper(as_optname)

case "SO_ERROR"

ll_optname = 4103

case "SO_RCVBUF"

ll_optname = 4098

case "SO_SNDBUF"

ll_optname = 4097

case "SO_TYPE"

ll_optname = 4104

case else

Return SOCKET_ERROR

end choose

// get option value

If getsockopt(aul_socket, SOL_SOCKET, &

ll_optname, ll_optvalue, ll_buflen) = 0 Then

Return ll_optvalue

Else

Return SOCKET_ERROR

End If

end function

public function string of_getuserid ();// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_GetUserid

// PURPOSE: This function retrieves the userid used to establish

// the current network connection.

// RETURN: The userid or null string if error occurred.

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

String ls_userid

ULong lul_result, lul_buflen

lul_buflen = 32

ls_userid = Space(lul_buflen)

lul_result = WNetGetUser("", ls_userid, lul_buflen)

If lul_result <> 0 Then

SetNull(ls_userid)

End If

Return ls_userid

end function

public function boolean of_ioctlsocket (unsignedlong aul_socket, string as_cmdname, ref unsignedlong aul_argp);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_IoctlSocket

// PURPOSE: This function controls the I/O mode of a socket.

// ARGUMENTS: aul_socket - Open socket

// as_cmdname - Which command to execute

// aul_argp - Input/Output parm

// For FIONBIO:

// aul_argp = 0 - Set Blocking mode

// aul_argp <> 0 - Set Nonblocking mode

// For FIONREAD:

// aul_argp - returns the amount of data avail to recv

// RETURN: True=Success

// False=Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

// #define FIONREAD _IOR('f', 127, u_long) /* get # bytes to read */

// #define FIONBIO _IOW('f', 126, u_long) /* set/clear non-blocking i/o */

// #define FIOASYNC _IOW('f', 125, u_long) /* set/clear async i/o */

Constant ulong FIONBIO = 2147772030 // &H8004667E

Constant ulong FIONREAD = 1074030207 // &H4004667F

Constant ulong SIOCATMARK = 1074033415 // &H40047307

Long ll_result

ULong lul_cmd

choose case Upper(as_cmdname)

case "FIONBIO"

lul_cmd = FIONBIO

case "FIONREAD"

lul_cmd = FIONREAD

case "SIOCATMARK"

lul_cmd = SIOCATMARK

case else

Return False

end choose

ll_result = ioctlsocket(aul_socket, lul_cmd, aul_argp)

If ll_result = SOCKET_ERROR Then

Return False

End If

Return True

end function

public subroutine of_jaguarlog (integer ai_msglevel, string as_msgtext);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_JaguarLog

// PURPOSE: This function writes a message to the Jaguar Log.

// ARGUMENTS: ai_msglevel - The level of message importance

// as_msgtext - The text of the message

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

String ls_msg

TransactionServer lts_jag

ErrorLogging lel_jag

// get reference to transaction service

GetContextService("TransactionServer", lts_jag)

// get reference to error logging service

GetContextService("ErrorLogging", lel_jag)

// build message text

choose case ai_msglevel

case iERROR

ls_msg = this.ClassName() + " (Error)->" + as_msgtext

case iWARN

ls_msg = this.ClassName() + " (Warning)->" + as_msgtext

case else

ls_msg = this.ClassName() + " (Info)->" + as_msgtext

end choose

// log message to server log

lel_jag.Log(ls_msg)

end subroutine

public function unsignedlong of_listen (unsignedinteger aui_port);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Listen

// PURPOSE: This function opens a socket and Listens.

// ARGUMENTS: aui_port - Port number

// RETURN: 0 = Error

// >0 = Success ( a valid socket )

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// 09/16/2010 RolandS Changed Port to unsignedinteger

// -----------------------------------------------------------------------------

HOSTENT lstr_hostent

SOCKADDR lstr_sockaddr

String ls_hostname

ULong lul_socket, lul_ptr, lul_ipaddr

// get information about host

ls_hostname = of_GetHostname()

lul_ptr = gethostbyname(ls_hostname)

If lul_ptr > 0 Then

// initialize structure

CopyMemoryIp(lstr_hostent, lul_ptr, MAXGETSOCKADDRSTRUCT)

CopyMemoryIp(lul_ipaddr, lstr_hostent.h_Addr_List, lstr_hostent.h_Length)

CopyMemoryIp(lstr_sockaddr.sin_addr, lul_ipaddr, lstr_hostent.h_Length)

lstr_sockaddr.sin_family = AF_INET

lstr_sockaddr.sin_port = htons(aui_port)

// create socket

lul_socket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

// bind the socket to an IP Address and Port

If bind(lul_socket, lstr_sockaddr, MAXGETSOCKADDRSTRUCT) = SOCKET_ERROR Then

lul_socket = 0

Else

// put the socket into Listen mode

If listen(lul_socket, SOMAXCONN) = SOCKET_ERROR Then

lul_socket = 0

End If

Else

lul_socket = 0

End If

Return lul_socket

end function

public function unsignedlong of_listen (unsignedinteger aui_port, long al_handle, integer ai_event);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Listen

// PURPOSE: This function opens a socket and Listens. An event will be

// triggered when a connection request is detected.

// ARGUMENTS: aui_port - Port number

// al_handle - Handle of object to receive messages

// ai_event - pbm_customxx event to receive messages

// RETURN: 0 = Error

// >0 = Success ( a valid socket )

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// 09/16/2010 RolandS Changed Port to unsignedinteger

// -----------------------------------------------------------------------------

Constant Integer WM_USER = 1024

HOSTENT lstr_hostent

SOCKADDR lstr_sockaddr

String ls_hostname

ULong lul_socket, lul_ptr, lul_ipaddr

Long ll_wsevent

// get information about host

ls_hostname = of_GetHostname()

lul_ptr = gethostbyname(ls_hostname)

If lul_ptr > 0 Then

// initialize structure

CopyMemoryIp(lstr_hostent, lul_ptr, MAXGETSOCKADDRSTRUCT)

CopyMemoryIp(lul_ipaddr, lstr_hostent.h_Addr_List, lstr_hostent.h_Length)

CopyMemoryIp(lstr_sockaddr.sin_addr, lul_ipaddr, lstr_hostent.h_Length)

lstr_sockaddr.sin_family = AF_INET

lstr_sockaddr.sin_port = htons(aui_port)

// create socket

lul_socket = socket(AF_INET, SOCK_STREAM, IPPROTO_TCP)

// bind the socket to an IP Address and Port

If bind(lul_socket, lstr_sockaddr, MAXGETSOCKADDRSTRUCT) = SOCKET_ERROR Then

lul_socket = 0

Else

ll_wsevent = FD_ACCEPT + FD_READ

// set Window handle and Event for notification

If WSAASyncSelect(lul_socket, al_handle, &

WM_USER + (ai_event - 1), ll_wsevent) = SOCKET_ERROR Then

lul_socket = 0

Else

// put the socket into Listen mode

If listen(lul_socket, SOMAXCONN) = SOCKET_ERROR Then

lul_socket = 0

End If

Else

lul_socket = 0

End If

Return lul_socket

end function

public subroutine of_messagebox (integer ai_msglevel, string as_msgtext);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_MessageBox

// PURPOSE: This function displays a messagebox.

// ARGUMENTS: ai_msglevel - The level of message importance

// as_msgtext - The text of the message

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

choose case ai_msglevel

case iERROR

MessageBox( "Winsock Error", &

as_msgtext, StopSign!)

case iWARN

MessageBox( "Winsock Warning", &

as_msgtext, Exclamation!)

case else

MessageBox( "Winsock Message", &

as_msgtext, Information!)

end choose

end subroutine

public function long of_parse (string as_text, string as_sep, ref string as_array[]);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Parse

// PURPOSE: This function parses a string into an array.

// ARGUMENTS: as_text - The string to be separated

// as_sep - The separator characters

// as_array - By ref output array

// RETURN: The number of items in the array

// DATE CHANGED BY DESCRIPTION OF CHANGE / REASON

// ---------- ---------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

String ls_empty[], ls_work

Long ll_pos, ll_each

as_array = ls_empty

If IsNull(as_text) Or as_text = "" Then Return 0

ll_pos = Pos(as_text, as_sep)

DO WHILE ll_pos > 0

ls_work = Trim(Left(as_text, ll_pos - 1))

as_text = Trim(Mid(as_text, ll_pos + 1))

as_array[UpperBound(as_array) + 1] = ls_work

ll_pos = Pos(as_text, as_sep)

LOOP

as_array[UpperBound(as_array) + 1] = Trim(as_text)

Return UpperBound(as_array)

end function

public function boolean of_recv (unsignedlong aul_socket, ref blob ablob_data);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Recv

// PURPOSE: This function receives data from a connected socket.

// ARGUMENTS: aul_socket - Open socket

// ablob_data - By ref blob

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Long ll_bytes, ll_MaxBuffer

Blob lblob_data

ll_MaxBuffer = of_GetSockOpt(aul_socket, "SO_RCVBUF")

ll_bytes = ll_MaxBuffer

do while ll_bytes = ll_MaxBuffer

lblob_data = Blob(Space(ll_MaxBuffer))

ll_bytes = recv(aul_socket, lblob_data, ll_MaxBuffer, 0)

If ll_bytes = SOCKET_ERROR Then

SetNull(ablob_data)

Return False

Else

ablob_data += BlobMid(lblob_data, 1, ll_bytes)

End If

loop

Return True

end function

public function boolean of_recv (unsignedlong aul_socket, ref string as_data);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Recv

// PURPOSE: This function receives data from a connected socket.

// ARGUMENTS: aul_socket - Open socket

// as_data - By ref string

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblob_data

If of_Recv(aul_socket, lblob_data) Then

If ib_recv_unicode Then

as_data = String(lblob_data)

Else

as_data = String(lblob_data, EncodingAnsi!)

End If

Else

SetNull(as_data)

Return False

End If

Return True

end function

public function boolean of_recvfrom (unsignedinteger aui_port, ref blob ablob_data, ref string as_ipaddress);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_RecvFrom

// PURPOSE: This function receives a UDP packet.

// ARGUMENTS: aui_port - The port to receive the packet on

// ablob_data - Buffer to hold the data (by ref)

// as_ipaddress - Sending IP Address (by ref)

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

SOCKADDR lstr_RecvAddr, lstr_SenderAddr

ULong lul_RecvSocket, lul_ipaddr

Long ll_bytes, ll_BufLen, ll_SenderAddrSize

String ls_ipaddress, ls_part[]

ll_SenderAddrSize = MAXGETSOCKADDRSTRUCT

ll_BufLen = Len(ablob_data)

lul_RecvSocket = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)

lstr_RecvAddr.sin_family = AF_INET

lstr_RecvAddr.sin_port = htons(aui_port)

lstr_RecvAddr.sin_addr.s_addr = htonl(INADDR_ANY)

bind(lul_RecvSocket, lstr_RecvAddr, MAXGETSOCKADDRSTRUCT)

ll_bytes = recvfrom(lul_RecvSocket, ablob_data, ll_BufLen, &

0, lstr_SenderAddr, ll_SenderAddrSize);

If ll_bytes = SOCKET_ERROR Then

closesocket(lul_RecvSocket)

Return False

Else

// trim off trailing blanks

ablob_data = BlobMid(ablob_data, 1, ll_bytes)

// format incoming IP address

lul_ipaddr = ntohl(lstr_SenderAddr.sin_addr.s_addr)

ls_ipaddress = String(Blob(inet_ntoa(lul_ipaddr)), EncodingAnsi!)

// reverse the order of the parts

of_Parse(ls_ipaddress, ".", ls_part)

as_ipaddress = ls_part[4] + "." + ls_part[3] + "." + &

ls_part[2] + "." + ls_part[1]

End If

closesocket(lul_RecvSocket)

Return True

end function

public function boolean of_recvfrom (unsignedinteger aui_port, ref string as_data, ref string as_ipaddress);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_RecvFrom

// PURPOSE: This function receives a UDP packet.

// ARGUMENTS: aui_port - The port to receive the packet on

// as_data - Buffer to hold the data (by ref)

// as_ipaddress - Sending IP Address (by ref)

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblob_data

lblob_data = Blob(as_data)

If of_RecvFrom(aui_port, lblob_data, as_ipaddress) Then

If ib_recv_unicode Then

as_data = String(lblob_data)

Else

as_data = String(lblob_data, EncodingAnsi!)

End If

Else

SetNull(as_data)

Return False

End If

Return True

end function

public function boolean of_send (unsignedlong aul_socket, blob ablob_data);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Send

// PURPOSE: This function sends data on a connected socket.

// ARGUMENTS: aul_socket - Open socket

// ablob_data - Data to send

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblob_data

Long ll_MaxBuffer, ll_totbytes, ll_length, ll_sendlen, ll_rc

ll_MaxBuffer = of_GetSockOpt(aul_socket, "SO_SNDBUF")

ll_length = Len(ablob_data)

do while ll_totbytes < ll_length

lblob_data = BlobMid(ablob_data, ll_totbytes + 1, ll_MaxBuffer)

ll_sendlen = Len(lblob_data)

ll_totbytes += ll_sendlen

ll_rc = send(aul_socket, lblob_data, ll_sendlen, 0)

If ll_rc = SOCKET_ERROR Then

Return False

End If

loop

Return True

end function

public function boolean of_send (unsignedlong aul_socket, string as_data);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Send

// PURPOSE: This function sends data on a connected socket.

// ARGUMENTS: aul_socket - Open socket

// as_data - Data to send

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblb_data

If ib_send_unicode Then

lblb_data = Blob(as_data)

Else

lblb_data = Blob(as_data, EncodingAnsi!)

End If

Return of_Send(aul_socket, lblb_data)

end function

public function boolean of_sendto (string as_ipaddress, unsignedinteger aui_port, blob ablob_data);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_SendTo

// PURPOSE: This function sends a UDP packet.

// ARGUMENTS: as_ipaddress - The IP Address to send to

// aui_port - The Port to send to

// ablob_data - Data to be sent

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

SOCKADDR lstr_RecvAddr

ULong lul_SendSocket

Long ll_RecvAddrSize, ll_rc, ll_BufLen

String ls_errmsg

ll_RecvAddrSize = MAXGETSOCKADDRSTRUCT

ll_BufLen = Len(ablob_data)

lul_SendSocket = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)

lstr_RecvAddr.sin_family = AF_INET

lstr_RecvAddr.sin_port = htons(aui_port)

lstr_RecvAddr.sin_addr.s_addr = inet_addr(as_ipaddress)

ll_rc = sendto(lul_SendSocket, ablob_data, ll_BufLen, &

0, lstr_RecvAddr, ll_RecvAddrSize)

If ll_rc = SOCKET_ERROR Then

Return False

End If

closesocket(lul_SendSocket)

Return True

end function

public function boolean of_sendto (string as_ipaddress, unsignedinteger aui_port, string as_data);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_SendTo

// PURPOSE: This function sends a UDP packet.

// ARGUMENTS: as_ipaddress - The IP Address to send to

// aui_port - The Port to send to

// as_data - Data to be sent

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Blob lblb_data

If ib_send_unicode Then

lblb_data = Blob(as_data)

Else

lblb_data = Blob(as_data, EncodingAnsi!)

End If

Return of_SendTo(as_ipaddress, aui_port, lblb_data)

end function

public function boolean of_setblockingmode (unsignedlong aul_socket, boolean ab_blocking);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_SetBlockingMode

// PURPOSE: This function changes the blocking mode of a socket.

// ARGUMENTS: aul_socket - Open socket

// ab_blocking - True=Blocking, False=NonBlocking

// RETURN: True=Success

// False=Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

ULong lul_ioctl

If ab_blocking Then

lul_ioctl = 0 // make the socket blocking

Else

lul_ioctl = 1 // make the socket non-blocking

End If

Return of_IoctlSocket(aul_socket, "FIONBIO", lul_ioctl)

end function

public subroutine of_setlasterror (string as_lasterror);// -----------------------------------------------------------------------------

// FUNCTION: n_winsock.of_SetLastError

// PURPOSE: This function sets the last error code so that the

// of_GetLastError function will display the passed message.

// ARGUMENTS: as_lasterror - Error message to save

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 09/03/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

is_lasterror = as_lasterror

WSASetLastError(0)

end subroutine

public function boolean of_setsockopt (unsignedlong aul_socket, string as_optname, boolean ab_optvalue);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_SetSockOpt

// PURPOSE: This function sets options that use the boolean datatype.

// ARGUMENTS: aul_socket - Open socket

// as_optname - Option name

// ab_optvalue - Option value

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

Constant Long SOL_SOCKET = 65535

Long ll_optname, ll_buflen

String ls_errmsg

ll_buflen = 1

choose case Upper(as_optname)

case "SO_BROADCAST"

ll_optname = 32

case "SO_DEBUG"

ll_optname = 1

case "SO_DONTROUTE"

ll_optname = 16

case "SO_KEEPALIVE"

ll_optname = 8

case "SO_OOBINLINE"

ll_optname = 256

case "SO_REUSEADDR"

ll_optname = 4

case "SO_LINGER"

ll_optname = 128

case else

Return False

end choose

// set option value

If setsockopt(aul_socket, SOL_SOCKET, &

ll_optname, ab_optvalue, ll_buflen) = 0 Then

Return True

Else

Return False

End If

end function

public subroutine of_setunicode (boolean ab_send, boolean ab_recv);// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_SetUnicode

// PURPOSE: This function sets Unicode data option.

// ARGUMENTS: ab_send - of_Send Unicode setting

// ab_recv - of_Recv Unicode setting

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

ib_send_unicode = ab_send

ib_recv_unicode = ab_recv

end subroutine

public function boolean of_startup ();// -----------------------------------------------------------------------------

// SCRIPT: n_winsock.of_Startup

// PURPOSE: This function initiates use of the socket library.

// RETURN: True = Success

// False = Error

// DATE PROG/ID DESCRIPTION OF CHANGE / REASON

// ---------- -------- -----------------------------------------------------

// 08/20/2010 RolandS Initial coding

// -----------------------------------------------------------------------------

If Not ib_initialized Then

If WSAStartup(257, istr_wsadata) = 0 Then

ib_initialized = True

Else

Return False

End If

Return True

end function

on n_winsock.create

call super::create

TriggerEvent( this, "constructor" )

end on

on n_winsock.destroy

TriggerEvent( this, "destructor" )

call super::destroy

end on

terça-feira, dezembro 28, 2010

The Dark Side of SOA

Artigo publicado com os problemas que as empresas enfrentam na implementação do SOA.

The Dark Side of SOA

Microsoft Connect

Você gostaria de dar alguma sugestão no desenvolvimento do Excel? Tem uma boa ideia para o Visual Studio?

A Microsoft disponibiliza o Microsoft Connect (https://connect.microsoft.com) , com o objetivo de permitir a comunidade sugerir novas implementações e votar sugestões de outras pessoas.

Para sugerir melhorias ao Visual Studio, acesse https://connect.microsoft.com/VisualStudio

Visual Studio - Vídeos de demos

No link abaixo você pode encontrar vários vídeos de demonstração de features do Visual Studio

Videos do Visual Studio

Abaixo uma relação de vídeos recomendados:

http://channel9.msdn.com/blogs/visualstudio/requirements-management-and-traceability-with-visual-studio-team-system-2010

http://channel9.msdn.com/Blogs/VisualStudio/Enterprise-Project-Management-with-Visual-Studio-Team-System-2010

http://channel9.msdn.com/Blogs/VisualStudio/Manual-Testing-with-Visual-Studio-Team-System-2010

http://channel9.msdn.com/shows/10-4/10-4-Episode-1-Working-with-the-Visual-Studio-2010-CTP-VPC/

http://channel9.msdn.com/blogs/kreekman/techdays-2010-software-testing-with-microsoft-visual-studio-2010

http://channel9.msdn.com/Blogs/kreekman/TechDays-2010-A-Lap-Around-Visual-Studio-2010-Application-Lifecycle-Management

http://channel9.msdn.com/Blogs/martinesmann/ALMday-session-1-New-Application-Lifecycle-Management-features-of-Visual-Studio-2010

http://channel9.msdn.com/Blogs/martinesmann/ALMday-session-2-Software-Testing-with-Microsoft-Visual-Studio-2010-Part-1-an-Introduction

http://channel9.msdn.com/blogs/visualstudio/better-software-quality-with-visual-studio-team-system-2010

http://channel9.msdn.com/Blogs/martinesmann/ALMday-session-4-Software-Testing-with-Microsoft-Visual-Studio-2010-Part-2-Making-It-Real

http://channel9.msdn.com/Blogs/martinesmann/ALMday-session-3-Using-TMAP-with-TFS-2010-in-software-development-projects

https://msevents.microsoft.com/CUI/WebCastEventDetails.aspx?culture=en-IN&EventID=1032456285&CountryCode=IN

https://msevents.microsoft.com/CUI/WebCastEventDetails.aspx?culture=en-US&EventID=1032466387&CountryCode=US

http://msdn.microsoft.com/pt-br/vstudio/gg440605.aspx

http://msdn.microsoft.com/pt-br/azure/dd638035.aspx

terça-feira, novembro 09, 2010

O Teste do Joel: 12 Passos para um Código Melhor

Amigos,
um amigo meu, Rodrigo Almeida de Oliveira, me enviou o artigo abaixo e achei muito interessante, compartilhando com vocês.

O Teste do Joel: 12 Passos para um Código Melhor

Qual o nível da Reengenharia que você precisa?

As duas pulgas
Max Gehringer

Duas pulgas estavam conversando e então uma comentou com a outra:

- Sabe qual é o nosso problema? Nós não voamos, só sabemos saltar.
Daí nossa chance de sobrevivência quando somos percebidas pelo cachorro é zero. É por isso que existem muito mais moscas do que pulgas.

Elas então contrataram uma mosca como consultora, entraram num programa de reengenharia de vôo e saíram voando.

Passado algum tempo, a primeira pulga falou para a outra:

- Quer saber? Voar não é o suficiente, porque ficamos grudadas ao corpo do cachorro e nosso tempo de reação é bem menor do que a velocidade da coçada dele.

Temos de aprender a fazer como as abelhas, que sugam o néctar e levantam vôo rapidamente.

Elas então contrataram o serviço de consultoria de uma abelha, que lhes ensinou a técnica do chega-suga-voa. Funcionou, mas não resolveu.. . A primeira pulga explicou porquê:

- Nossa bolsa para armazenar sangue é pequena, por isso temos de ficar muito tempo sugando. Escapar, a gente até escapa, mas não estamos nos alimentando direito. Temos de aprender como os pernilongos fazem para se alimentar com aquela rapidez.

E então um pernilongo lhes prestou uma consultoria para incrementar o tamanho do abdômen. Resolvido, mas por poucos minutos.
... Como tinham ficado maiores, a aproximação delas era facilmente percebida pelo cachorro, e elas eram espantadas antes mesmo de pousar.
Foi aí que encontraram uma saltitante pulguinha, que lhes perguntou:

- Ué, vocês estão enormes! Fizeram plástica?

- Não, reengenharia. Agora somos pulgas adaptadas aos desafios do século XXI. Voamos, picamos e podemos armazenar mais alimento.

- E por que é que estão com cara de famintas?

- Isso é temporário. Já estamos fazendo consultoria com um morcego, que vai nos ensinar a técnica do radar. E você?

- Ah, eu vou bem, obrigada. Forte e sadia.

Mas as pulgonas não quiseram dar a pata a torcer, e perguntaram à pulguinha: - Mas você não está preocupada com o futuro? Não pensou em uma reengenharia?

- Quem disse que não? Contratei uma lesma como consultora.

- Mas o que as lesmas têm a ver com pulgas. quiseram saber as pulgonas...

- Tudo. Eu tinha o mesmo problema que vocês duas. Mas, em vez de dizer para a lesma o que eu queria, deixei que ela avaliasse a situação e me sugerisse a melhor solução. E ela passou três dias

ali, quietinha, só observando o cachorro e então ela me disse:
"Não mude nada. Apenas sente na nuca do cachorro. É o único lugar que a pata dele não alcança".

MORAL DA HISTÓRIA:

Você não precisa de uma reengenharia radical, nem de um complexo projeto para ser mais eficiente.
Muitas vezes, a GRANDE MUDANÇA é uma simples questão de reposicionamento.

segunda-feira, novembro 01, 2010

Controle de Código Fontes

O tema de como controlar os fontes de um programa (Source Control) já possui várias linhas de discussão na Internet e cada um defende uma linha.

Na minha opinião, a melhor ferramenta é o Microsoft Team Foundation Server (TFS), sendo que a maior vantagem é armazenar os arquivos em um banco de dados SQL Server, facilitando o backup/restore e a manutenção do banco, além de todas as vantagens que um banco de dados SQL Server fornece. O lado ruim é o custo, porém, se comparado aos benefícios, justifica o investimento.

A uns dez anos atrás, elaborei um manual de como usar o VSS, que em muitas empresas foram migradas para o TFS. Porém e durante vários anos, tivemos N problemas com este modelo e sempre me questionei se era a melhor forma de gerenciar códigos fontes.

Na semana passada, em uma reunião com a Microsoft sobre ALM, fiz este questionamento a mesma, expondo os problemas enfrentados. Em resposta, me passaram o site abaixo que explica como a Microsoft gerência os códigos fontes dos produtos, inclusive o Windows e o Office. O artigo é sensacional e responde a quase todas as minhas perguntas. O próximo passo é colocar o que está documentado em prática.

Abaixo o link para a documentação da Microsoft.

Visual Studio TFS Branching Guide 2010

PowerBuilder - Funções de conversão ascii para ebcdic/ebcdic para ascii

Função escrita por Jorge Batista Piazzarollo

// Converte ascii para ebcdic
long ll_pos, ll_len
as_ebcdic = ''
// Recupera o tamanho da string
ll_len = Len(as_ascii)
// Converte cada caractere
for ll_pos = 1 to ll_len
as_ebcdic = as_ebcdic + charA(tabela_toebcdic[AscA(Mid(as_ascii, ll_pos, 1)) + 1])
next
return
=====================================

//Converte ebcdic para ascii
long ll_pos, ll_len
as_ascii = ''
// Recupera o tamanho da string
ll_len = Len(as_ebcdic)
// Converte cada caractere
for ll_pos = 1 to ll_len
as_ascii = as_ascii + charA(tabela_toascii[AscA(Mid(as_ebcdic, ll_pos, 1)) + 1])
next
return

quarta-feira, outubro 13, 2010

What is ALM?

Está na moda o uso do termo ALM (Application lifecycle management) ou gerenciamento do ciclo de vida da aplicação.

Achei um artigo muito interessante sobre o tema e recomendo a leitura. Abaixo o Link para o mesmo:
What Is ALM

No site do David Chappell existem outros artigos muito interessantes sobre o mesmo assunto.

SQL Server: o backup do Transaction Log

Achei o artigo abaixo na Internet e achei o conteúdo muito interessante, pois muita gente não sabe o objetivo do Transaction Log e nem como usar. Recomendo uma leitura até para os mais experientes.

SQL Server: o backup do Transaction Log

segunda-feira, outubro 11, 2010

PowerBuilder - Migração para PB12

Abaixo um link para a documentação oficial da Sybase de como migrar para PowerBuilder 12

http://www.sybase.com/detail?id=1032777

PowerBuilder - Suporte as versões do Oracle

Abaixo um link onde você pode encontrar as versões do PowerBuilder e as versões do Oracle suportadas oficialmente pela Sybase.

http://www.sybase.com.br/detail?id=1011566

domingo, outubro 03, 2010

Problemas com Sincronismo do meu Windows Mobile

Estou a dias tentando configurar o meu SmartPhone Windows Mobile (Touch Pro com Windows Mobile 6.1) com o meu computador (Windows 7 Enterprise 64 bits, Outlook 2010 64 Bits e WMDC 64 Bits) e para a minhas surpresa encontrei o seguinte artigo no TechEd

"Windows Mobile Device Center (WMDC) synchronization WMDC does not synchronize with Microsoft Outlook 2010 if you use the 64-bit version of Outlook 2010. In such cases, an error message displays that states that there is no default mail client or the current mail client cannot fulfill the messaging. WMDC synchronizes correctly with the 32-bit version of Outlook 2010. To synchronize a Windows Phone with Outlook 2010 by using Windows Mobile Device Center, uninstall Outlook 2010 64-bit. Then use the original installer that you used to obtain Outlook 2010 64-bit to install Outlook 2010 32-bit. Outlook 2010 32-bit is the default option." http://technet.microsoft.com/en-us/library/ee681792.aspx

Como não concordo em ter que utilizar o Office 32 bits no meu Windows 64 bits, irei manter o computador sincronizando via Exchange Server, ficando sem sincronizar os Notes.

Qualquer dica de como sincronizar os Notes será me vinda.

Abraços

quinta-feira, agosto 27, 2009

PowerBuilder - Is the Application a Good Fit for the Internet?

Is the Application a Good Fit for the Internet?

Not all PowerBuilder applications will move smoothly to the Internet with every approach described here. Variables such as the size and complexity of the application, the use of Windows-only features such as OLE, DDE, and third party OCXs, the number of DataWindows used in each Window, the size of the SQL result sets retrieved, the PowerBuilder framework used, and even coding practices and the general quality of the code will all determine the options open to you. Other variables that will all impact your decision include the complexity of the UI presentation style and the use of drag and drop in the application. The chart below should serve as only a general guideline and not an indication of which approach is best for your organization.

*Technique*	*PB Windows Forms*	*PB Web Forms*	*PB Web* DataWindow	*CITRIX or Terminal Svcs.*	*Appeon*
*MDIInterface*	Y	Y, using tabs	N/A	Y	Y
*Drag and* Drop	Y	N	N	Y	Y
*OLE, OCX*	Y	N	N	Y (server-side)	Y
*Client-Side Integration*	Y	Via JavaScript	Via JavaScript	Disks and printers only	Y
*Server-Side Integration*	Y	Y	Y	Y	Y
*Level of* Effort	Minor	Significant	Highest	Least	Minor
*Fidelity* *of UI*	Highest	Good	Good	Excellent	Excellent
*Strengths*	Easy, good UI, broad capability	Best for simple UI, ground up true web dev	Scalability, good for Java and low level control	Easy to set up and deploy	Client & server integration, scalability, performance
*Weaknesses*	Bandwidth, footprint on client	Event postback model inherent to ASP .NET 2.0	Strong need for good 3-tier architecture, more hand coding	Scalability, cost	Technology created by a Sybase Partner.