1: Attribute VB_Name = "Module2" 2: Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer 3: Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer 4: Declare Function SetWindowPos Lib "user32" (ByVal p1 As Long, ByVal p2%, ByVal p3%, ByVal p4%, ByVal p5%, ByVal p6%, ByVal p7%) As Integer 5: Declare Function GetVersion Lib "kernel32" Alias "GetVersionA" () As Long 6: Declare Function sndPlaySound Lib "winmm.dll" alias "sndPlaySoundA" (ByVal lpszSoundName$, ByVal wFlags%) As Integer 7: Declare Function GetWindow Lib "user32" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer 8: Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd%, ByVal lpSting$, ByVal nMaxCount%) As Integer 9: Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd%) As Integer 10: 11: Function ExistDir(ByVal DirName$) 12: On Error Resume Next 13: X$ = CurDir$ 14: If Right$(DirName$, 1) = "\" And Len(DirName$) > 3 Then DirName$ = Left$(DirName$, Len(DirName$) - 1) 15: ChDir (DirName$) 16: If Err = 0 Then ExistDir = True Else ExistDir = False 17: Err = 0 18: ChDir (X$) 19: End Function 20: 21: 22: Sub LoadTaskList(Lst As ListBox) 23: CurrWnd = GetWindow(List1.Parent.hWnd, 0) 24: Do While CurrWnd <> 0 25: Length = GetWindowTextLength(CurrWnd) + 1 26: ListItem$ = Space$(Length) 27: Length = GetWindowText(CurrWnd, ListItem$, Length) 28: If Length > 0 Then 29: Lst.AddItem ListItem$ 30: End If 31: CurrWnd = GetWindow(CurrWnd, 2) 32: DoEvents 33: Loop 34: End Sub 35: Function RGBtoInt(RGB, Colr) 36: If Colr < 1 Or Colr > 3 Then Exit Function 37: cl$ = String$(6 - Len(Hex$(RGB)), "0") + Hex$(RGB): Clr = (Colr - 4) * -1 38: RGBtoInt = Val("&H" + Mid$(cl$, (Clr * 2) - 1, 2)) 39: End Function 40: Sub Make3DControl(X As Control, xxz) 41: On Error Resume Next 42: Err = 0 43: BordStyl = X.BorderStyle 44: If Err = 0 Then Else BordStyl = 1 45: If xxz = 7 Then BordStyl = 0: xxz = 0 46: If xxz = 8 Then BordStyl = 0: xxz = 1 47: If xxz = 9 Then BordStyl = 1: xxz = 0 48: If xxz = 10 Then BordStyl = 1: xxz = 1 49: If X.Parent.BackColor <> QBColor(7) And xxz <> 5 And xxz <> 6 Then X.Parent.BackColor = QBColor(7) 50: X.Parent.AutoRedraw = True 51: If xxz = 5 Then xxz = 0 52: If BordStyl = 0 Then zxxz = 10 53: If xxz = 0 Then c1 = 8: c2 = 15: c3 = 0: c4 = 7 Else c1 = 7: c2 = 0: c3 = 15: c4 = 8 54: If xxz = 50 Then c1 = 7: c2 = 7: c3 = 7: c4 = 7 55: X.Parent.Line (X.Left - 20 - zxxz, X.Top - 10)-(X.Left - 20 - zxxz, X.Top + X.Height + zxxz), QBColor(c1) 56: X.Parent.Line (X.Left - 20, X.Top - 10 - (zxxz * 2))-(X.Left + X.Width + 10 + zxxz, X.Top - 10 - (zxxz * 2)), QBColor(c1) 57: X.Parent.Line (X.Left - 20 - zxxz, X.Top + X.Height + zxxz)-(X.Left + X.Width + 10 + (zxxz * 2), X.Top + X.Height + zxxz), QBColor(c2) 58: X.Parent.Line (X.Left + X.Width + zxxz, X.Top - 10)-(X.Left + X.Width + zxxz, X.Top + X.Height + 10), QBColor(c2) 59: If BordStyl = 0 Then 60: X.Parent.Line (X.Left - 20, X.Top - 10)-(X.Left - 20, X.Top + X.Height), QBColor(c3) 61: X.Parent.Line (X.Left - 20, X.Top - 10)-(X.Left + X.Width + 10, X.Top - 10), QBColor(c3) 62: X.Parent.Line (X.Left - 20, X.Top + X.Height)-(X.Left + X.Width + 10, X.Top + X.Height), QBColor(c4) 63: X.Parent.Line (X.Left + X.Width, X.Top - 10)-(X.Left + X.Width, X.Top + X.Height + 10), QBColor(c4) 64: End If 65: End Sub 66: 67: Function BIN$(nvm) 68: ff$ = UCase$(Hex$(nvm)) 69: For Q = 1 To Len(ff$) 70: g$ = Mid$(ff$, Q, 1) 71: If g$ = "0" Then XOut$ = XOut$ + "0000" 72: If g$ = "1" Then XOut$ = XOut$ + "0001" 73: If g$ = "2" Then XOut$ = XOut$ + "0010" 74: If g$ = "3" Then XOut$ = XOut$ + "0011" 75: If g$ = "4" Then XOut$ = XOut$ + "0100" 76: If g$ = "5" Then XOut$ = XOut$ + "0101" 77: If g$ = "6" Then XOut$ = XOut$ + "0110" 78: If g$ = "7" Then XOut$ = XOut$ + "0111" 79: If g$ = "8" Then XOut$ = XOut$ + "1000" 80: If g$ = "9" Then XOut$ = XOut$ + "1001" 81: If g$ = "A" Then XOut$ = XOut$ + "1010" 82: If g$ = "B" Then XOut$ = XOut$ + "1011" 83: If g$ = "C" Then XOut$ = XOut$ + "1100" 84: If g$ = "D" Then XOut$ = XOut$ + "1101" 85: If g$ = "E" Then XOut$ = XOut$ + "1110" 86: If g$ = "F" Then XOut$ = XOut$ + "1111" 87: Next Q 88: BIN$ = XOut$ 89: End Function 90: 91: Function Bin2Int(Bns$) 92: For Q = 1 To Len(Bns$) Step 4 93: Nbl = Val(Mid$(Bns$, Q, 4)) 94: If Val(Nbl) = 0 Then Bn$ = Bn$ + "0" 95: If Val(Nbl) = 1 Then Bn$ = Bn$ + "1" 96: If Val(Nbl) = 10 Then Bn$ = Bn$ + "2" 97: If Val(Nbl) = 11 Then Bn$ = Bn$ + "3" 98: If Val(Nbl) = 100 Then Bn$ = Bn$ + "4" 99: If Val(Nbl) = 101 Then Bn$ = Bn$ + "5" 100: If Val(Nbl) = 110 Then Bn$ = Bn$ + "6" 101: If Val(Nbl) = 111 Then Bn$ = Bn$ + "7" 102: If Val(Nbl) = 1000 Then Bn$ = Bn$ + "8" 103: If Val(Nbl) = 1001 Then Bn$ = Bn$ + "9" 104: If Val(Nbl) = 1010 Then Bn$ = Bn$ + "A" 105: If Val(Nbl) = 1011 Then Bn$ = Bn$ + "B" 106: If Val(Nbl) = 1100 Then Bn$ = Bn$ + "C" 107: If Val(Nbl) = 1101 Then Bn$ = Bn$ + "D" 108: If Val(Nbl) = 1110 Then Bn$ = Bn$ + "E" 109: If Val(Nbl) = 1111 Then Bn$ = Bn$ + "F" 110: Next Q 111: Bin2Int = Val("&H" + Bn$) 112: End Function 113: 114: Function ConvertBase$(ByVal D, ByVal Nb) 115: Do While D > 0 116: R = D Mod Nb 117: If R < 10 Then Digit$ = Chr$(R + 48) Else Digit$ = Chr$(R + 55) 118: N$ = Right$(Digit$, 1) + N$ 119: D = D \ Nb 120: Loop 121: ConvertBase$ = N$ 122: End Function 123: 124: Sub CopyFile(src As String, dst As String, TotalSize, xssx As Label, Percent As Integer) 125: Path1$ = src 126: path2$ = dst 127: If Not FileExist(Path1$) Then MsgBox "File not found: " + Path1$: GoTo 1101 128: If FileExist(path2$) And UCase$(LastPart$(path2$, "\")) <> "VB40032.DLL" Then Kill path2$ 129: total = TotalSize 130: Open Path1$ For Binary As #1 131: Open path2$ For Binary As #2 132: Per1 = Percent 133: incc = (LOF(1) / total) * 100 134: Dim ff As String * 10000 135: For Q = 1 To LOF(1) 136: Percent = ((Q / LOF(1)) * incc) + Per1 137: If Percent > lstper Then xssx.Caption = RTrim$(LTrim$(Str$(Percent))): lstper = Percent 138: Get #1, , ff 139: If Q + Len(ff) > LOF(1) Then gg$ = Mid$(ff$, 1, (LOF(1) - Q) + 1): Put #2, , gg$ Else Put #2, , ff 140: sx = DoEvents() 141: Q = Q + Len(ff$) - 1 142: Next Q 143: 1101 Close 1, 2 144: End Sub 145: 146: Sub CreateDDELink(topi$, exec$, ddelnk As Label) 147: On Error Resume Next 148: ddelnk.LinkTopic = topi$ 149: ddelnk.LinkMode = 2 150: For qqq = 1 To 100 151: xx = DoEvents() 152: Next qqq 153: ddelnk.LinkTimeout = 100 154: ddelnk.LinkExecute exec$ 155: ddelnk.LinkMode = 0 156: ddelnk.LinkTimeout = 50 157: End Sub 158: 159: Sub CreateProgGroup(nme$, Fnm$, ddelnk As Label) 160: On Error Resume Next 161: ddelnk.LinkTopic = "ProgMan|Progman" 162: ddelnk.LinkMode = 2 163: For qqq = 1 To 100 164: xx = DoEvents() 165: Next qqq 166: ddelnk.LinkTimeout = 100 167: ddelnk.LinkExecute "[CreateGroup(" + nme$ + "," + Fnm$ + ")]" 168: ddelnk.LinkMode = 0 169: ddelnk.LinkTimeout = 50 170: End Sub 171: 172: Sub CreateProgItem(fm$, nme$, Destin As String, ddelnk As Label) 173: On Error Resume Next 174: For Q = 1 To Len(fm$) 175: If Mid$(fm$, Q, 2) = "*1" Then Q = Q + 1: Fnm$ = Fnm$ + Destin Else Fnm$ = Fnm$ + Mid$(fm$, Q, 1) 176: Next Q 177: ddelnk.LinkTopic = "ProgMan|Progman" 178: ddelnk.LinkMode = 2 179: For qqq = 1 To 500 180: z% = DoEvents() 181: Next qqq 182: ddelnk.LinkTimeout = 100 183: ddelnk.LinkExecute "[AddItem(" + Fnm$ + "," + nme$ + ",,,)]" 184: 'For qqq = 1 To 500 185: 'z% = DoEvents() 186: 'Next qqq 187: ddelnk.LinkMode = 0 188: ddelnk.LinkTimeout = 50 189: End Sub 190: 191: 192: Sub Draw3DLine(X1, Y1, X2, Y2, X As Form) 193: On Error Resume Next 194: X.AutoRedraw = True 195: If X.BackColor <> QBColor(7) Then X.BackColor = QBColor(7) 196: If Y1 = Y2 Then Chk2 = 20 197: If X1 = X2 Then chk1 = 20 198: If X1 <> X2 And Y1 <> Y2 Then chk1 = 20 199: X.Line (X1, Y1)-(X2, Y2), QBColor(8) 200: X.Line (X1 + chk1, Y1 + Chk2)-(X2 + chk1, Y2 + Chk2), QBColor(15) 201: End Sub 202: 203: Sub DrawFormBack(mm As Form) 204: xx = 255 205: vin = mm.Width 206: vass = (254 / vin) 207: xzxz = mm.DrawWidth 208: For Q = 0 To vin Step xzxz 209: mm.Line (Q, 0)-(Q, mm.Height), RGB(0, 0, xx) 210: xx = xx - (vass * xzxz) 211: Next Q 212: mm.Refresh 213: End Sub 214: 215: Sub DrawGoodBack(mm As Control) 216: xx = 255 217: vin = mm.Width 218: vass = (254 / vin) 219: xzxz = mm.DrawWidth 220: For Q = 0 To vin Step xzxz 221: mm.Line (Q, 0)-(Q, mm.Height), RGB(0, 0, xx) 222: xx = xx - (vass * xzxz) 223: Next Q 224: mm.Refresh 225: End Sub 226: 227: Sub DrawGraph(N, X As PictureBox) 228: If X.AutoRedraw = 0 Then X.AutoRedraw = True 229: PerCen = Int((SizeOfCircle / 100) * N) 230: SizeOfCircle = WhichIsGreater(X.Width * -1, X.Height * -1) * -1 231: X.FillStyle = 0: X.FillColor = RGB(127, 0, 127) 232: X.Circle (Int(X.Width / 2), Int(X.Height / 2)), Int(SizeOfCircle / 2), QBColor(0), , , 0.45 233: X.FillStyle = 0: X.FillColor = RGB(255, 0, 255) 234: X.Circle (Int(X.Width / 2), Int(X.Height / 2) - 120), Int(SizeOfCircle / 2), QBColor(0), , , 0.4 235: X.Line (Int(X.Width / 2), Int(X.Height / 2) - 120)-(Int(X.Width / 2) - Int(SizeOfCircle / 2), Int(X.Height / 2) - 120) 236: X.Line (Int(X.Width / 2), Int(X.Height / 2) - 120)-(Int(X.Width / 2) - Int(SizeOfCircle / 2) + PerCen, Int(X.Height / 2) - 120 + PerCen) 237: End Sub 238: 239: Sub DrawPerBar(X As Integer, Where As PictureBox, ForeColor As Long) 240: If Where.AutoRedraw = False Then Where.AutoRedraw = True 241: Where.Cls 242: If Where.BorderStyle = False Then BordOr3D = False 243: If Where.Appearance = 1 Then BordOr3D = 2 244: Where.Line (10, 10)-Step(((Where.Width - 35) / 100) * X, Where.Height - 75 + (((BordOr3D - 1) * -1) * 30)), ForeColor, BF 245: End Sub 246: 247: Sub DrawPercentBar(X As Integer, Where As PictureBox) 248: Spacen = 55 'Int((Where.Width / 100)) 249: 'xz = Int(300 / 6) 250: If X Mod (Where.Width / 980) = 0 Then 251: 'If x Mod 6 = 0 Then 252: Where.Line ((X * Spacen) - 254, 15)-Step(254, 250), QBColor(1), BF 253: End If 254: End Sub 255: 256: Function FileExist(filename As String) 257: On Error Resume Next 258: Open filename For Input As #7 259: If Err <> 0 Then 260: FileExist = False 261: Else 262: FileExist = True 263: End If 264: Close 7 265: End Function 266: 267: Function Fixed$(Txt$) 268: 269: If Left$(Txt$, 1) = " " Or Left$(Txt$, 1) = "\" Then Txt$ = Left$(CurDir$, 1) + Txt$ 270: For Q = 1 To Len(Txt$) 271: If Mid$(Txt$, Q, 1) = "?" Or Mid$(Txt$, Q, 1) = "*" Or Mid$(Txt$, Q, 1) = "+" Or Asc(Mid$(Txt$, Q, 1)) < 33 Then Else mm$ = mm$ + Mid$(Txt$, Q, 1) 272: Next Q 273: mm$ = LTrim$(RTrim$((mm$))) 274: If Right$(mm$, 1) = "\" Then Else mm$ = mm$ + "\" 275: If Mid$(Txt$, 2, 1) <> ":" Then mm$ = Left$(Txt$, 1) + ":" + Right$(Txt$, Len(Txt$) - 1) 276: If Mid$(mm$, 3, 1) <> "\" Then mm$ = Left$(mm$, 2) + "\" + Right$(mm$, Len(mm$) - 2) 277: For Q = 1 To Len(mm$) 278: If Mid$(mm$, Q, 1) = "?" Or Mid$(mm$, Q, 1) = "*" Or Mid$(mm$, Q, 1) = "+" Or Asc(Mid$(mm$, Q, 1)) < 33 Then Else mmm$ = mmm$ + Mid$(mm$, Q, 1) 279: Next Q 280: For Q = 1 To Len(mmm$) 281: If Mid$(mmm$, Q, 1) = "\" And PastMM$ = "\" Then mmm$ = Left$(mmm$, Q - 1) + Right$(mmm$, Len(mmm$) - Q): Q = Q - 1 282: PastMM$ = Mid$(mmm$, Q, 1) 283: Next Q 284: Fixed$ = mmm$ 285: End Function 286: 287: Function GetWindowsDir$() 288: temp$ = String$(145, 0) 289: X = GetWindowsDirectory(temp$, 145) 290: temp$ = Left$(temp$, X) 291: If Right$(temp$, 1) <> "\" Then GetWindowsDir$ = temp$ + "\" Else GetWindowsDir$ = temp$ 292: End Function 293: 294: Function GetWindowsSysDir$() 295: temp$ = String$(145, 0) 296: X = GetSystemDirectory(temp$, 145) 297: temp$ = Left$(temp$, X) 298: If Right$(temp$, 1) <> "\" Then GetWindowsSysDir$ = temp$ + "\" Else GetWindowsSysDir$ = temp$ 299: End Function 300: 301: Sub IfExistMkDir(Drr$) 302: If ExistDir(Drr$) = False Then MkDir (Drr$) 303: End Sub 304: 305: Function IfLessThan(n1, n2) 306: If n1 < n2 Then IfLessThan = n1 307: End Function 308: 309: Function LastPart$(t$, s$) 310: For Q = Len(t$) To 1 Step -1 311: If Mid$(t$, Q, 1) = s$ Then Exit For Else ddd$ = Mid$(t$, Q, 1) + ddd$ 312: Next Q 313: LastPart$ = ddd$ 314: End Function 315: 316: 317: Sub Make3DLine(X As Line) 318: X1 = X.X1 319: X2 = X.X2 320: Y1 = X.Y1 321: Y2 = X.Y2 322: On Error Resume Next 323: X.Parent.AutoRedraw = True 324: If X.Parent.BackColor <> QBColor(7) Then X.Parent.BackColor = QBColor(7) 325: If Y1 = Y2 Then Chk2 = 20 326: If X1 = X2 Then chk1 = 20 327: If X1 <> X2 And Y1 <> Y2 Then chk1 = 20 328: X.BorderColor = QBColor(8) 329: X.Parent.Line (X1 + chk1, Y1 + Chk2)-(X2 + chk1, Y2 + Chk2), QBColor(15) 330: End Sub 331: 332: Sub Make4Style(X As Form) 333: If X.BorderStyle <> 0 Then Exit Sub 334: X.Line (0, 0)-(0, X.Height - 20), QBColor(7) 335: X.Line (15, 15)-(15, X.Height - 15), QBColor(15) 336: X.Line (35, 15)-(35, X.Height - 15), QBColor(7) 337: X.Line (0, X.Height - 15)-(X.Width - 0, X.Height - 15), QBColor(0) 338: X.Line (15, X.Height - 35)-(X.Width - 15, X.Height - 35), QBColor(8) 339: X.Line (15, X.Height - 50)-(X.Width - 15, X.Height - 50), QBColor(7) 340: X.Line (X.Width - 10, 0)-(X.Width - 10, X.Height), QBColor(0) 341: X.Line (X.Width - 30, 15)-(X.Width - 30, X.Height - 15), QBColor(8) 342: X.Line (X.Width - 45, 15)-(X.Width - 45, X.Height - 15), QBColor(7) 343: X.Line (0, 0)-(X.Width, 0), QBColor(7) 344: X.Line (15, 15)-(X.Width - 15, 15), QBColor(15) 345: X.Line (35, 35)-(X.Width - 35, 35), QBColor(7) 346: 347: End Sub 348: 349: Sub MakeFormFloat(X As Form, f%) 350: junls = SetWindowPos%(X.hWnd, f%, 0, 0, 0, 0, 3) 351: End Sub 352: 353: Function MakeLength$(tx$, nm, f$) 354: If Len(tx$) >= nm Then MakeLength$ = tx$: Exit Function 355: MakeLength$ = String$(nm - Len(tx$), f$) + tx$ 356: End Function 357: 358: Sub MkDirr(Dr$) 359: Drvv$ = Left$(Dr$, 2) 360: On Error Resume Next 361: For Q = 1 To Len(Dr$) 362: If Mid$(Dr$, Q, 1) = "\" And dd = 1 Then dd = 0: IfExistMkDir (Drvv$ + "\" + xx$): xx$ = xx$ + "\" 363: If Mid$(Dr$, Q, 1) = "\" And dd = 0 Then dd = 1 364: If Mid$(Dr$, Q, 1) <> "\" And dd = 1 Then xx$ = xx$ + Mid$(Dr$, Q, 1) 365: Next Q 366: If ExistDir(Drvv$ + "\" + xx$) = False Then MkDir (Drvv$ + "\" + xx$) 367: End Sub 368: 369: Function NumOfOccurs(Txt$, s$) 370: If Mid$(Txt$, 1, 1) <> "»" Then Txt$ = "»" + Txt$ 371: For Q = 1 To Len(Txt$) 372: If Mid$(Txt$, Q, 1) = s$ Then dds = dds + 1 373: Next Q 374: NumOfOccurs = dds 375: End Function 376: 377: Function PartsOfString(t$, l$) 378: For aa = 1 To Len(t$) 379: If UCase$(Mid$(t$, aa, Len(l$))) = UCase$(l$) Then i = i + 1 380: Next aa 381: PartsOfString = i 382: End Function 383: 384: Sub PlayWav(wav$) 385: SND_SYNC = &H0 386: SND_ASYNC = &H1 387: SND_NODEFAULT = &H2 388: SND_LOOP = &H8 389: SND_NOSTOP = &H10 390: wFlags% = SND_ASYNC Or SND_NODEFAULT 391: X% = sndPlaySound(wav$, wFlags%) 392: End Sub 393: 394: Sub SelectAll(X As TextBox) 395: X.SelStart = 0 396: X.SelLength = Len(X.Text) 397: End Sub 398: 399: Function StrToInt(t$) 400: For Q = 1 To Len(t$) 401: dd$ = MakeLength$(Hex$(Asc(Mid$(t$, Q, 1))), 2, "0") + dd$ 402: Next Q 403: StrToInt = Val("&H" + dd$) 404: End Function 405: 406: Function SwitchUp(ByVal n1, ByVal n2, ByVal n3) 407: If n1 = n2 Then SwitchUp = n3 Else SwitchUp = n2 408: End Function 409: 410: Function TRIMS$(n1) 411: TRIMS$ = LTrim$(RTrim$(Str$(n1))) 412: End Function 413: 414: Function TypeOfDir$(Vld$, Pth$) 415: If UCase$(Vld$) = "INVAILD DIRECTORY" Then TypeOfDir$ = Vld$: Exit Function 416: If Right$(Pth$, 1) = "\" Then Else Pth$ = Pth$ + "\" 417: If Right$(UCase$(Pth$), 2) = ":\" Then TypeOfDir$ = "Root Directory": Exit Function 418: If UCase$(GetWindowsDir$()) = UCase$(Pth$) Then TypeOfDir$ = "Windows Directory (" + WindowsVersion$() + ")": Exit Function 419: If UCase$(GetWindowsSysDir$()) = UCase$(Pth$) Then TypeOfDir$ = "Windows SYSTEM Directory (" + WindowsVersion$() + ")": Exit Function 420: If PartsOfString(Pth$, "\") = 2 Then TypeOfDir$ = "Root Directory Entry" Else TypeOfDir$ = "Sub Directory" 421: End Function 422: 423: Sub Unpack(Path1$, path2 As String, TotalSize, xdx As Label, Percent As Integer) 424: Pack$ = Path1$ 425: nl$ = Chr$(13) + Chr$(10) 426: On Error Resume Next 427: Err = 0 428: Open Pack$ For Binary As #2 429: If Err <> 0 Then MsgBox "File Not Found: " + Pack$: Exit Sub 430: Dim ff As String * 100 431: Dim nme As String * 12 432: Dim nth As String * 1 433: Dim sz As Single 434: Dim Percn As Integer 435: Percn = 1 436: total = TotalSize 437: Do Until Loc(2) >= LOF(2) 438: Per1 = Percent 439: Get #2, , nme 440: flnm$ = RTrim$(LTrim$(nme)) 441: Get #2, , sz 442: filsiz = sz 443: If flnm$ = "123456789012" Then GoTo 1231 444: 'Form3.Label1.Caption = "Source:" + nl$ + Pack$ + nl$ + nl$ + "Destination:" + nl$ + path2 + flnm$ 445: If FileExist(path2 + flnm$) Then Kill (path2 + flnm$) 446: Open path2 + flnm$ For Binary As #1 447: For mm = 0 To filsiz - 1 448: If (mm / total) * 100 < 0 Then Stop 449: Get #2, , ff 450: If Len(ff) + mm > filsiz Then gg$ = Left$(ff, filsiz - mm): Put #1, , gg$: Get #2, (((Loc(2) - Len(ff)) + Len(gg$))), nth: mm = mm + Len(gg$): Exit For Else Put #1, , ff 451: Percent = ((mm / (total)) * 100) + Per1 452: If Percn <> Percent Then Percn = Percent: xdx.Caption = LTrim$(RTrim$(Str$(Percn))) 453: mm = (mm + Len(ff)) - 1 454: X = DoEvents() 455: Next mm 456: Close 1 457: Loop 458: 1231 Close 1, 2, 4, 5, 6, 7, 8, 9 459: End Sub 460: 461: Function WhichIsGreater(p1, p2) 462: If p1 > p2 Then WhichIsGreater = p1 Else WhichIsGreater = p2 463: End Function 464: 465: Function WindowsVersion$() 466: TheVerInfo& = GetVersion() 467: WinVer& = TheVerInfo& And &HFFFF& 468: xxss$ = RTrim$(LTrim$(Str$(WinVer& Mod 256))) + "." + RTrim$(LTrim$(Str$(WinVer& \ 256))) 469: If Val(xxss$) = 3.95 Then WindowsVersion$ = "Windows 95" Else WindowsVersion$ = "Windows " + xxss$ 470: If Mid$(xxss$, 1, 3) = "3.5" Then WindowsVersion$ = "Windows NT" 471: End Function 472: |