From fb11ffeb2d98f239b20e618c65b8534b677957e9 Mon Sep 17 00:00:00 2001 From: Jeffrey Armstrong Date: Wed, 24 Mar 2021 14:58:32 -0400 Subject: Initial import --- common/wsa.f90 | 68 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 common/wsa.f90 (limited to 'common/wsa.f90') diff --git a/common/wsa.f90 b/common/wsa.f90 new file mode 100644 index 0000000..080da11 --- /dev/null +++ b/common/wsa.f90 @@ -0,0 +1,68 @@ +! Copyright (c) 2020 Jeffrey Armstrong +! +! Permission is hereby granted, free of charge, to any person obtaining a copy +! of this software and associated documentation files (the "Software"), to deal +! in the Software without restriction, including without limitation the rights +! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +! copies of the Software, and to permit persons to whom the Software is +! furnished to do so, subject to the following conditions: +! +! The above copyright notice and this permission notice shall be included in +! all copies or substantial portions of the Software. +! +! The Software shall be used for Good, not Evil. +! +! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +! SOFTWARE. + +module wsa_network +use iso_c_binding +implicit none + + integer, parameter::wsa_description_length_plus_1 = 256 + + type, bind(c) :: wsadata + integer(kind=c_int16_t)::wVersion + integer(kind=c_int16_t)::wHighVersion + integer(kind=c_short)::iMaxSockets + integer(kind=c_short)::iMaxUdpDg + + type(c_ptr)::lpVendorInfo + character(len=1, kind=c_char), dimension(wsa_description_length_plus_1)::szDescription + character(len=1, kind=c_char), dimension(wsa_description_length_plus_1)::szSystemStatus + end type + +contains + + subroutine startup() + use iso_c_binding + implicit none + + interface + function wsa_startup(v, p) bind(c, name="WSAStartup") + use iso_c_binding + integer(kind=c_int16_t), value::v + type(c_ptr), value::p + integer(kind=c_int)::wsa_startup + end function wsa_startup + end interface + + type(wsadata), target::startup_data + integer::res + + ! need to use wVersionRequested = MAKEWORD(2, 2); + + + res = wsa_startup(int(z'0202', kind=c_int16_t), c_loc(startup_data)) + if(res /= 0) then + Print *, "Windows Networking failed to start" + Print *, "Error=", res + stop + end if + end subroutine startup +end module wsa_network -- cgit v1.2.3