wincit/ipcsupp.bas

   1 Attribute VB_Name = "IPCSUPP"
   2 Global tcpconnected
   3 Global count_serv_puts&
   4 Global InTrans
   5 Global TCPinbuf$
   6
   7 Type BBSdir
   8     Name As String * 80
   9     PhoneOrAddress As String * 50
  10     TCPport As Integer
  11     End Type
  12
  13 Global CurrBBS As BBSdir
  14 Global editedBBSnum As Integer
  15
  16 Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
  17 Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  18 Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  19
  20
  21
  22 Function begin_trans() As Integer
  23
  24     If InTrans = True Then
  25         begin_trans = False
  26     Else
  27         InTrans = True
  28         MainWin.MousePointer = 11
  29         begin_trans = True
  30         End If
  31 End Function
  32
  33
  34
  35
  36 Sub end_trans()
  37     MainWin.MousePointer = 0
  38     InTrans = False
  39 End Sub
  40
  41 Function GetPrivateProfileVBString(lpApplicationName As String, lpKeyName As String, nDefault As String, ByVal lpFileName As String) As String
  42
  43     buf$ = "                                                                     "
  44     a% = GetPrivateProfileString(lpApplicationName, lpKeyName, nDefault, buf$, Len(buf$), lpFileName)
  45
  46
  47     GetPrivateProfileVBString = StripTrailingWhiteSpace(buf$)
  48 End Function
  49
  50
  51 Function serv_gets()
  52     buf$ = ""
  53
  54         Do
  55             DoEvents
  56             Loop While InStr(TCPinbuf$, Chr$(10)) = 0
  57         b% = InStr(TCPinbuf$, Chr$(10))
  58         serv_gets = Left$(TCPinbuf$, b% - 1)
  59         TCPinbuf$ = Right$(TCPinbuf$, Len(TCPinbuf$) - b%)
  60
  61 End Function
  62
  63 Sub serv_puts(buf$)
  64     IPC.TCP.Send (buf$ + Chr$(10))
  65 End Sub
  66
  67 Function serv_read(bytes As Integer)
  68     buf$ = ""
  69
  70         Do
  71             DoEvents
  72             Loop While Len(TCPinbuf$) < bytes
  73         serv_read = Left$(TCPinbuf$, bytes)
  74         TCPinbuf$ = Right$(TCPinbuf$, Len(TCPinbuf$) - bytes)
  75
  76
  77 End Function
  78
  79 Sub Transmit_Buffer(SendBuf As String)
  80             a$ = SendBuf
  81             Do Until Len(a$) = 0
  82                 nl% = InStr(a$, Chr$(13) + Chr$(10))
  83                 If (nl% > 0) And (nl% < 200) Then
  84                     serv_puts (Left$(a$, nl% - 1))
  85                     a$ = " " + Right$(a$, Len(a$) - nl% - 1)
  86                     End If
  87                 If (nl% = 0) And (Len(a$) < 200) Then
  88                     serv_puts (a$)
  89                     a$ = ""
  90                     End If
  91                 If ((nl% = 0) And (Len(a$) >= 200)) Or (nl% >= 200) Then
  92                     ns% = 0
  93                     For z = 1 To Len(a$)
  94                         y = InStr(z, a$, " ")
  95                         If (y > ns%) Then ns% = y
  96                         Next z
  97                     If (ns% = 0) Or (ns% >= 200) Then ns% = 200
  98                     serv_puts (Left$(a$, ns% - 1))
  99                     a$ = Right$(a$, Len(a$) - ns%)
 100                     End If
 101                 Loop
 102
 103 End Sub
 104