[绘图界面库] fortran语言实现socket通信/winsock

Module SocketMod
  Use ws2_32 , ID_Cancel => IDCancel
  Use kernel32 , only : sleep
  Implicit None  
  Type t_sockaddr_union
    Sequence
    union
      map
        Type (t_sockaddr_in) sockaddrin
      end map
      map
        Type (t_sockaddr) sockaddr
      end map
    end union
  End Type t_sockaddr_union
  Integer , parameter , private :: winsock_v2_2 = x'202' , success = 0 !版本
contains

  Integer Function Socket_UDP_Conn( host , port )
    Character(len=15) host
    Integer(kind=2) port
    type (t_wsadata) WSAInfo !版本信息结构
    !integer receivelen , iSendLen     , ic
    type (t_sockaddr_union) ConnectionInfo !Client_add
    Integer hSocket , status , i
    Socket_UDP_Conn = 0
    status = WSAStartup(winsock_v2_2, WSAInfo)
    If (status/=success) return
! 创建套接字
    hSocket = Socket( af_inet , SOCK_DGRAM , ipproto_udp )
    If (hSocket==invalid_socket) goto 999
    ConnectionInfo.sockaddrin.sin_family = af_inet
    ConnectionInfo.sockaddrin.sin_port = htons( port )
    ConnectionInfo.sockaddrin.sin_addr%s_addr = inet_addr( host( 1 : len_trim(host) ) )
    status = Connect(hSocket, %ref(ConnectionInfo%sockaddr), sizeof(ConnectionInfo%sockaddr))
    If (status==socket_error) return        
    i = 1
    status = ioctlsocket( hSocket , FIONBIO , loc(1) )
    Socket_UDP_Conn = hSocket
    return
999 status = WSACleanup()
  End Function Socket_UDP_Conn
  
  Integer Function Socket_UDP_Disconn( hSocket )
    integer :: hSocket
    Socket_UDP_Disconn = CloseSocket( hSocket )
    Socket_UDP_Disconn = WSACleanup()
  End Function Socket_UDP_Disconn
  
  Integer Function Socket_UDP_Send( hSocket , c , len_c )
    Character(len=*) :: c
    Integer :: len_c    
    Integer hSocket , iSendLen
    Socket_UDP_Send = 0
    iSendLen = Send( hSocket , c , len_c , 0 )
    If ( iSendLen < 0 ) return
    Socket_UDP_Send = 1
  End Function Socket_UDP_Send
  
  Integer Function Socket_UDP_Recv( hSocket , c , len_c , timeout )
    Character(len=*) :: c
    Integer :: len_c , timeout   
    Integer :: hSocket , receivelen , i
    Socket_UDP_Recv = 0
    c = char(0)
    do i = 1 , timeout
      receivelen = Recv( hSocket , c , len_c , 0 )
      If ( receivelen == len_c ) goto 999
      call sleep(10)
    end do
    return
999 Socket_UDP_Recv = 1
  End Function Socket_UDP_Recv
  
End Module SocketMod

 subroutine exchangedata(iDof,iblock,dpred,rfoutput)
      use ws2_32
      use kernel32

      character*500 dpred
      character*500 d
      integer iDof,iblock
      character*500 rfoutput
      dimension fdpred(iblock)


      type t_sockaddr_union
          sequence
          union
              map
                  type(t_sockaddr_in)sockAddrIn
              end map
              map
                  type(t_sockaddr)sockAddr
              end map
          end union
      end type t_sockaddr_union

      parameter(iwinsock_v2_2=x'202',isuccess=0)  
      type(t_wsadata) WSAInfo !版本信息结构
      type (t_sockaddr_union) ConnectionInfo !Client_add

      type T_client_server_message
          union
              map
                  character*(500) buffer
              end map
              map
                  character*(500) bufferout
              end map
          end union
      end type
      type(T_client_server_message) ClientServerMessage

      Character(len=15) host
      Integer(kind=2) iport


c**************************************************************************       

         ! Initialize Winsock v2
         istatus=WSAStartup(iwinsock_v2_2,WSAInfo)
      If (istatus.NE.isuccess)then
         write(*,*)'WSAStartup-',istatus
      stop
      end if

         ! 创建套接字
      isender = socket( af_inet , SOCK_STREAM , ipproto_tcp )
      if (isender.EQ.invalid_socket) then
       write(*,*)'socket-',invalid_socket
       istatus=WSACleanup()
      end if

        !设置连接地址
      host='127.0.0.1'
      iport=5001


      ConnectionInfo%sockaddrin%sin_family = af_inet
      ConnectionInfo%sockaddrin%sin_port = htons( iport )
      ConnectionInfo%sockaddrin%sin_addr%s_addr =
     *        inet_addr( host( 1 : len_trim(host) ) )
      istatus = connect(isender, %ref(ConnectionInfo%sockaddr), 
     *         sizeof(ConnectionInfo%sockaddr))
      If (istatus.EQ.socket_error) then
      write(*,*)"连接失败"
      end if
c*****************************************************************************************
      ! 接收数据
      ireceivelen=recv(isender,ClientServerMessage%buffer,500,0)
         if(ireceivelen<0)then
          write(*,*)"连接失败"
          stop
         else
             dpred=ClientServerMessage%buffer
             write(*,*)"sever say:"
             write(*,*) dpred
             read(dpred,*) fdpred
             write(*,*) fdpred
         end if

c***********************************************************************************         

         ! 发送数据
      write(*,*)"please enter message:"
      write(*,*) rfoutput
      ClientServerMessage%bufferout=rfoutput
      isendlen=send(isender,ClientServerMessage%bufferout,500,0)
      write(*,*) ClientServerMessage%bufferout
      rfoutput=ClientServerMessage%bufferout
      write(*,*) rfoutput
      if(isendlen<0)then
          write(*,*)"连接失败"
      end if

             istatus=closesocket(isender)
             istatus=WSACleanup()

      end subroutine

Type T_DAQ
    SEQUENCE
    character(len=3) :: cFlagStart !// 一般会有帧头，但不是必须的
    !// 此处是你的各数据，用 type 会更方便多种不同数据放在一起
    character(len=3) :: cFlagEnd !// 一般会有帧尾，但不是必须的
  End Type T_DAQ

type(T_DAQ) , private :: stDAQ !// 这是你真正的数据
character(len=80) , private :: C_DAQ !// 这是为了方便书写
Equivalence( C_DAQ , stDAQ ) !// 让 C_DAQ 和 stDAQ 公用一个内存地址!这样，当你传输时，使用 C_DAQ，而使用时，使用 stDAQ