Attribute VB_Name = "Module1" Option Explicit Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Global havetranslation As Integer Global haveretranslation As Integer Type rhymetype name As String wavefile As String rhyme As String End Type Global Rhymes() As rhymetype Global nrhymes As Integer Global thisrhyme As Integer Public Type testtype s As String * 3 strarray(5) As String b() As Byte End Type Public r As testtype Public Type s4type s As String * 4 End Type Public s4 As s4type Public Type i2type i(1) As Integer End Type Global i2 As i2type Public Type b4type b(3) As Byte End Type Global b4 As b4type Public Type pttype x As Integer y As Integer End Type Global pt As pttype Public Type bntype b() As Byte End Type Global bn As bntype Public Type i32type i(31) As Integer End Type Global i32 As i32type Public Type s32type s As String * 32 End Type Global s32 As s32type Sub strToBytes(s As String, b() As Byte, n As Long) Dim pt As Long Dim a() As Byte a = StrConv(s, vbFromUnicode) For pt = 0 To n - 1 b(pt) = a(pt) Next End Sub Sub strToInt(s As String, i() As Integer, n As Long) Dim pt As Long Dim a() As Byte Dim st As s32type Dim i2 As i32type a = StrConv(s, vbFromUnicode) st.s = a LSet i2 = st For pt = 0 To n - 1 i(pt) = i2.i(pt) Next End Sub Sub puttofile(f As String, s As String) '__ '__ GLOBAL PutFile '__ '__ parameter f As String '__ parameter s As String '__ '__ called by Form1.Command3_Click '__ Dim unit As Integer On Error Resume Next unit = FreeFile Open f For Output As unit Print #unit, s Close unit End Sub Function loadfromfile(fname As String, nchar As Long) As String '__ '__ GLOBAL loadfromfile '__ '__ parameter fname As String '__ parameter pt As Long '__ parameter mustexist As Integer '__ '__ called by GLOBAL doeval '__ called by GLOBAL doprof '__ called by GLOBAL findinsmallfile '__ called by GLOBAL GetIDNames '__ called by GLOBAL GetPlaceInfo '__ called by GLOBAL LoadModel '__ called by GLOBAL main '__ called by GLOBAL makehtml '__ Dim s As String Dim unit As Integer Dim w As Long 'in this version of loadfromfile, pt indicates the maximum number of bytes to load On Error Resume Next unit = FreeFile Open fname For Input As unit: Close unit If Err Then Exit Function Open fname For Binary As unit Seek unit, 1 w = LOF(unit) s = Space(IIf(nchar > 0 And w > nchar, nchar, w)) Get unit, , s Close unit Err = 0 loadfromfile = s End Function Function strextr(st As String, ch As String) As String '__ '__ GLOBAL strextr '__ '__ parameter st As String '__ parameter ch As String '__ '__ called by GLOBAL ChopData '__ called by GLOBAL doasst '__ called by GLOBAL docheckasst '__ called by GLOBAL doprof '__ called by GLOBAL FindAllLines '__ called by GLOBAL getcriticaldata '__ called by GLOBAL getEmailInfo '__ called by GLOBAL putfulleval '__ called by GLOBAL GetGradeInfo '__ called by GLOBAL GetProfLines '__ called by GLOBAL GetMyPlace '__ called by GLOBAL getprofinfo '__ called by GLOBAL getreturninfo '__ called by GLOBAL listsortdata '__ called by GLOBAL loadevalinfo '__ called by GLOBAL logmessage '__ called by GLOBAL makehtml '__ called by GLOBAL MakePlaceFile '__ called by GLOBAL MergeData '__ called by GLOBAL privatestrings '__ called by GLOBAL profof '__ called by GLOBAL puteval '__ called by GLOBAL sendtoprof '__ called by GLOBAL STUDCourseinfo '__ called by GLOBAL TranslateTableInfo '__ called by GLOBAL GetEmailAddress '__ called by GLOBAL HTTPGetIDNames '__ called by GLOBAL HTTPGetStudentID '__ called by GLOBAL getpassfrominfo '__ called by GLOBAL getSMTPTextString '__ called by GLOBAL sendthefile '__ Dim i As Integer i = InStr(st, ch) If i = 0 Then strextr = Trim(st) st = "" Else strextr = Trim(Left(st, i - 1)) st = Trim(Mid(st, i + Len(ch))) End If End Function Function strextrtail(st As String, ch As String) As String Dim i As Integer i = InStr(st, ch) If i = 0 Then strextrtail = Trim(st) st = "" Else strextrtail = Trim(Mid(st, i + Len(ch))) st = Trim(Left(st, i - 1)) End If End Function Function strtrim(s As String, sch As String) As String '__ '__ GLOBAL strtrim '__ '__ parameter s As String '__ parameter sch As String '__ '__ called by GLOBAL GetProfLines '__ called by GLOBAL GraderCheckInfo '__ called by GLOBAL MergeData '__ called by GLOBAL STUDCourseinfo '__ Dim i As Integer i = Len(s) If i = 0 Then Exit Function While Mid(s, i, 1) = sch i = i - 1 If i = 0 Then Exit Function Wend strtrim = Left(s, i) End Function Sub strsub(s As String, ch1 As String, ch2 As String) '__ '__ GLOBAL strsub '__ '__ parameter s As String '__ parameter ch1 As String '__ parameter ch2 As String '__ '__ called by GLOBAL cleantoend '__ called by GLOBAL doasst '__ called by GLOBAL docheckasst '__ called by GLOBAL doeval '__ called by GLOBAL DoProcessInfo '__ called by GLOBAL doprof '__ called by GLOBAL putfulleval '__ called by GLOBAL GetGradeInfo '__ called by GLOBAL loadevalinfo '__ called by GLOBAL makehtml '__ called by GLOBAL MakePlaceFile '__ called by GLOBAL puteval '__ called by GLOBAL sendtoprof '__ called by GLOBAL strsub '__ called by GLOBAL TranslateTableInfo '__ called by GLOBAL GetEmailAddress '__ called by GLOBAL HTTPGetIDNames '__ called by GLOBAL HTTPGetStudentID '__ called by GLOBAL checkwwwstring '__ called by GLOBAL getSMTPTextString '__ called by GLOBAL getuserinfo '__ calls GLOBAL strsub '__ Dim i As Integer Dim lch1 As Integer Dim CATCHR_RESERVED As String CATCHR_RESERVED = Chr(31) If InStr(ch2, ch1) > 0 Then Call strsub(s, ch1, CATCHR_RESERVED) Call strsub(s, CATCHR_RESERVED, ch2) Else lch1 = Len(ch1) i = InStr(s, ch1) If lch1 = Len(ch2) Then While i > 0 Mid(s, i, lch1) = ch2 i = InStr(s, ch1) Wend Else While i > 0 s = Left(s, i - 1) & ch2 & Mid(s, i + lch1) i = InStr(s, ch1) Wend End If End If End Sub Sub shellopen(url As String, mode As Integer) On Error Resume Next Dim l As Long l = ShellExecute(0&, "open", url, "", "", mode) 'ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long 'err code 2 under Windows 2000?? 'If l < 32 Then MsgBox ("Error code: " & l) End Sub