医药CRM系统开发

自已做医药CRM系统有四年了,终于可以算个产品了,努力市场化,今年重种将医药营销的理念加入CRM

导航

n_cst_ping在powerbuilder 11 中的变化,一面的程序可正常ping

Posted on 2012-07-19 22:27  hhq80  阅读(481)  评论(0编辑  收藏  举报

 

$PBExportHeader$n_cst_ping.sru
forward
global type n_cst_ping from nonvisualobject
end type
end forward

global type n_cst_ping from nonvisualobject
end type
global n_cst_ping n_cst_ping

type prototypes
//Open the socket connection.
FUNCTION Integer WSAStartup( uint UIVersionRequested, ref str_WSAData lpWSAData ) library "wsock32.dll" alias for "WSAStartup;ANSI"
//Clean up sockets.
FUNCTION Integer WSACleanup() library "wsock32.dll" alias for "WSACleanup;ANSI"
//Create a handle on which Internet Control Message Protocol (ICMP) requests can be issued.
FUNCTION Ulong IcmpCreateFile() Library "icmp.dll"
//Close an Internet Control Message Protocol (ICMP) handle that IcmpCreateFile opens.
FUNCTION Ulong IcmpCloseHandle(ULong IcmpHandle) Library "icmp.dll"
//Send an Internet Control Message Protocol (ICMP) echo request, and then return one or more replies.
FUNCTION Ulong IcmpSendEcho(ULong IcmpHandle,ULong DestinationAddress,String RequestData,ULong RequestSize,ULong RequestOptions,ref str_icmpechoreply ReplyBuffer,ULong ReplySize,ULong Timeout) Library "icmp.dll" alias for "IcmpSendEcho;ANSI"

// 轉換IP字串成IP資料位址Convert a string that contains an (Ipv4) Internet Protocol dotted address into a correct address.
FUNCTION ULong inet_addr(string ip_addr) library "ws2_32.dll" alias for "inet_addr;ANSI"

 

end prototypes
type variables
Constant ULong WS_VERSION_REQD = 257

Constant Long ICMP_SUCCESS = 0
Constant Long ICMP_STATUS_BUFFER_TO_SMALL = 11001  //Buffer Too Small
Constant Long ICMP_STATUS_DESTINATION_NET_UNREACH = 11002  //Destination Net Unreachable
Constant Long ICMP_STATUS_DESTINATION_HOST_UNREACH = 11003  //Destination Host Unreachable
Constant Long ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH = 11004  //Destination Protocol Unreachable
Constant Long ICMP_STATUS_DESTINATION_PORT_UNREACH = 11005  //Destination Port Unreachable
Constant Long ICMP_STATUS_NO_RESOURCE = 11006  //No Resources
Constant Long ICMP_STATUS_BAD_OPTION = 11007  //Bad Option
Constant Long ICMP_STATUS_HARDWARE_ERROR = 11008  //Hardware Error
Constant Long ICMP_STATUS_LARGE_PACKET = 11009  //Packet Too Big
Constant Long ICMP_STATUS_REQUEST_TIMED_OUT = 11010  //Request Timed Out
Constant Long ICMP_STATUS_BAD_REQUEST = 11011  //Bad Request
Constant Long ICMP_STATUS_BAD_ROUTE = 11012  //Bad Route
Constant Long ICMP_STATUS_TTL_EXPIRED_TRANSIT = 11013  //TimeToLive Expired Transit
Constant Long ICMP_STATUS_TTL_EXPIRED_REASSEMBLY = 11014  //TimeToLive Expired Reassembly
Constant Long ICMP_STATUS_PARAMETER = 11015  //Parameter Problem
Constant Long ICMP_STATUS_SOURCE_QUENCH = 11016  //Source Quench
Constant Long ICMP_STATUS_OPTION_TOO_BIG = 11017  //Option Too Big
Constant Long ICMP_STATUS_BAD_DESTINATION = 11018  //Bad Destination
Constant Long ICMP_STATUS_NEGOTIATING_IPSEC = 11032  //Negotiating IPSEC
Constant Long ICMP_STATUS_GENERAL_FAILURE = 11050  //General Failure

end variables

forward prototypes
public function string wf_icmpmsg (unsignedlong pingresponse)
public function boolean of_ping (string ls_pingip)
end prototypes

public function string wf_icmpmsg (unsignedlong pingresponse);String  ls_ret

Choose case PingResponse
  Case ICMP_SUCCESS
    ls_ret = "Success!"
  Case ICMP_STATUS_BUFFER_TO_SMALL
    ls_ret = "Buffer Too Small"
  Case ICMP_STATUS_DESTINATION_NET_UNREACH
    ls_ret = "Destination Net Unreachable"
  Case ICMP_STATUS_DESTINATION_HOST_UNREACH
    ls_ret = "Destination Host Unreachable"
  Case ICMP_STATUS_DESTINATION_PROTOCOL_UNREACH
    ls_ret = "Destination Protocol Unreachable"
  Case ICMP_STATUS_DESTINATION_PORT_UNREACH
    ls_ret = "Destination Port Unreachable"
  Case ICMP_STATUS_NO_RESOURCE
    ls_ret = "No Resources"
  Case ICMP_STATUS_BAD_OPTION
    ls_ret = "Bad Option"
  Case ICMP_STATUS_HARDWARE_ERROR
    ls_ret = "Hardware Error"
  Case ICMP_STATUS_LARGE_PACKET
    ls_ret = "Packet Too Big"
  Case ICMP_STATUS_REQUEST_TIMED_OUT
    ls_ret = "Request Timed Out"
  Case ICMP_STATUS_BAD_REQUEST
    ls_ret = "Bad Request"
  Case ICMP_STATUS_BAD_ROUTE
    ls_ret = "Bad Route"
  Case ICMP_STATUS_TTL_EXPIRED_TRANSIT
    ls_ret = "TimeToLive Expired Transit"
  Case ICMP_STATUS_TTL_EXPIRED_REASSEMBLY
    ls_ret = "TimeToLive Expired Reassembly"
  Case ICMP_STATUS_PARAMETER
    ls_ret = "Parameter Problem"
  Case ICMP_STATUS_SOURCE_QUENCH
    ls_ret = "Source Quench"
  Case ICMP_STATUS_OPTION_TOO_BIG
    ls_ret = "Option Too Big"
  Case ICMP_STATUS_BAD_DESTINATION
    ls_ret = "Bad Destination"
  Case ICMP_STATUS_NEGOTIATING_IPSEC
    ls_ret = "Negotiating IPSEC"
  Case ICMP_STATUS_GENERAL_FAILURE
    ls_ret = "General Failure"
  Case Else
    ls_ret = "Unknown Response"
End Choose

Return ls_ret

end function

public function boolean of_ping (string ls_pingip);str_wsadata  lstr_wsadata
str_icmpechoreply  lstr_reply
Ulong  lul_timeout , lul_address , lul_hIcmp , lul_size,li_ret
Integer  li_res
String  ls_send , ls_msg
li_ret=0
ls_send = "hello"
lul_timeout = 1000 //(ms , 1 秒)

lstr_wsadata.vendorinfo = space(256)
//建立SOCKET
li_res = wsastartup (WS_VERSION_REQD, lstr_wsadata)
if li_res <> 0 then return  li_ret=0
//轉換IP位址字串
 lul_address = inet_addr(ls_pingIP)
 if lul_address <> -1 and lul_address <> 0 then
    //建立ICMP請求
    lul_hIcmp = IcmpCreateFile()
    if isnull(lul_hIcmp) then
     li_ret=0
    else
   li_ret=IcmpSendEcho(lul_hIcmp, lul_address, ls_send, Len(ls_send), 0, lstr_reply,56,200)  
  
    //關閉ICMP請求
    IcmpCloseHandle(lul_hIcmp)
  end if
 end if
 
//關閉SOCKET
wsacleanup()

if li_ret>0 then
 return true
else
 return false
end if

end function

on n_cst_ping.create
call super::create
TriggerEvent( this, "constructor" )
end on

on n_cst_ping.destroy
TriggerEvent( this, "destructor" )
call super::destroy
end on