Attribute VB_Name = "Module2"
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
Declare Function SetWindowPos Lib "user32" (ByVal p1 As Long, ByVal p2%, ByVal p3%, ByVal p4%, ByVal p5%, ByVal p6%, ByVal p7%) As Integer
Declare Function GetVersion Lib "kernel32" Alias "GetVersionA" () As Long
Declare Function sndPlaySound Lib "winmm.dll" alias "sndPlaySoundA" (ByVal lpszSoundName$, ByVal wFlags%) As Integer
Declare Function GetWindow Lib "user32" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd%, ByVal lpSting$, ByVal nMaxCount%) As Integer
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd%) As Integer

Function ExistDir(ByVal DirName$)
On Error Resume Next
X$ = CurDir$
If Right$(DirName$, 1) = "\" And Len(DirName$) > 3 Then DirName$ = Left$(DirName$, Len(DirName$) - 1)
ChDir (DirName$)
If Err = 0 Then ExistDir = True Else ExistDir = False
Err = 0
ChDir (X$)
End Function


Sub LoadTaskList(Lst As ListBox)
CurrWnd = GetWindow(List1.Parent.hWnd, 0)
Do While CurrWnd <> 0
Length = GetWindowTextLength(CurrWnd) + 1
ListItem$ = Space$(Length)
Length = GetWindowText(CurrWnd, ListItem$, Length)
If Length > 0 Then
Lst.AddItem ListItem$
End If
CurrWnd = GetWindow(CurrWnd, 2)
DoEvents
Loop
End Sub
Function RGBtoInt(RGB, Colr)
If Colr < 1 Or Colr > 3 Then Exit Function
cl$ = String$(6 - Len(Hex$(RGB)), "0") + Hex$(RGB): Clr = (Colr - 4) * -1
RGBtoInt = Val("&H" + Mid$(cl$, (Clr * 2) - 1, 2))
End Function
Sub Make3DControl(X As Control, xxz)
On Error Resume Next
Err = 0
BordStyl = X.BorderStyle
If Err = 0 Then Else BordStyl = 1
If xxz = 7 Then BordStyl = 0: xxz = 0
If xxz = 8 Then BordStyl = 0: xxz = 1
If xxz = 9 Then BordStyl = 1: xxz = 0
If xxz = 10 Then BordStyl = 1: xxz = 1
If X.Parent.BackColor <> QBColor(7) And xxz <> 5 And xxz <> 6 Then X.Parent.BackColor = QBColor(7)
X.Parent.AutoRedraw = True
If xxz = 5 Then xxz = 0
If BordStyl = 0 Then zxxz = 10
If xxz = 0 Then c1 = 8: c2 = 15: c3 = 0: c4 = 7 Else c1 = 7: c2 = 0: c3 = 15: c4 = 8
If xxz = 50 Then c1 = 7: c2 = 7: c3 = 7: c4 = 7
X.Parent.Line (X.Left - 20 - zxxz, X.Top - 10)-(X.Left - 20 - zxxz, X.Top + X.Height + zxxz), QBColor(c1)
X.Parent.Line (X.Left - 20, X.Top - 10 - (zxxz * 2))-(X.Left + X.Width + 10 + zxxz, X.Top - 10 - (zxxz * 2)), QBColor(c1)
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)
X.Parent.Line (X.Left + X.Width + zxxz, X.Top - 10)-(X.Left + X.Width + zxxz, X.Top + X.Height + 10), QBColor(c2)
If BordStyl = 0 Then
X.Parent.Line (X.Left - 20, X.Top - 10)-(X.Left - 20, X.Top + X.Height), QBColor(c3)
X.Parent.Line (X.Left - 20, X.Top - 10)-(X.Left + X.Width + 10, X.Top - 10), QBColor(c3)
X.Parent.Line (X.Left - 20, X.Top + X.Height)-(X.Left + X.Width + 10, X.Top + X.Height), QBColor(c4)
X.Parent.Line (X.Left + X.Width, X.Top - 10)-(X.Left + X.Width, X.Top + X.Height + 10), QBColor(c4)
End If
End Sub

Function BIN$(nvm)
ff$ = UCase$(Hex$(nvm))
For Q = 1 To Len(ff$)
g$ = Mid$(ff$, Q, 1)
If g$ = "0" Then XOut$ = XOut$ + "0000"
If g$ = "1" Then XOut$ = XOut$ + "0001"
If g$ = "2" Then XOut$ = XOut$ + "0010"
If g$ = "3" Then XOut$ = XOut$ + "0011"
If g$ = "4" Then XOut$ = XOut$ + "0100"
If g$ = "5" Then XOut$ = XOut$ + "0101"
If g$ = "6" Then XOut$ = XOut$ + "0110"
If g$ = "7" Then XOut$ = XOut$ + "0111"
If g$ = "8" Then XOut$ = XOut$ + "1000"
If g$ = "9" Then XOut$ = XOut$ + "1001"
If g$ = "A" Then XOut$ = XOut$ + "1010"
If g$ = "B" Then XOut$ = XOut$ + "1011"
If g$ = "C" Then XOut$ = XOut$ + "1100"
If g$ = "D" Then XOut$ = XOut$ + "1101"
If g$ = "E" Then XOut$ = XOut$ + "1110"
If g$ = "F" Then XOut$ = XOut$ + "1111"
Next Q
BIN$ = XOut$
End Function

Function Bin2Int(Bns$)
For Q = 1 To Len(Bns$) Step 4
Nbl = Val(Mid$(Bns$, Q, 4))
If Val(Nbl) = 0 Then Bn$ = Bn$ + "0"
If Val(Nbl) = 1 Then Bn$ = Bn$ + "1"
If Val(Nbl) = 10 Then Bn$ = Bn$ + "2"
If Val(Nbl) = 11 Then Bn$ = Bn$ + "3"
If Val(Nbl) = 100 Then Bn$ = Bn$ + "4"
If Val(Nbl) = 101 Then Bn$ = Bn$ + "5"
If Val(Nbl) = 110 Then Bn$ = Bn$ + "6"
If Val(Nbl) = 111 Then Bn$ = Bn$ + "7"
If Val(Nbl) = 1000 Then Bn$ = Bn$ + "8"
If Val(Nbl) = 1001 Then Bn$ = Bn$ + "9"
If Val(Nbl) = 1010 Then Bn$ = Bn$ + "A"
If Val(Nbl) = 1011 Then Bn$ = Bn$ + "B"
If Val(Nbl) = 1100 Then Bn$ = Bn$ + "C"
If Val(Nbl) = 1101 Then Bn$ = Bn$ + "D"
If Val(Nbl) = 1110 Then Bn$ = Bn$ + "E"
If Val(Nbl) = 1111 Then Bn$ = Bn$ + "F"
Next Q
Bin2Int = Val("&H" + Bn$)
End Function

Function ConvertBase$(ByVal D, ByVal Nb)
Do While D > 0
R = D Mod Nb
If R < 10 Then Digit$ = Chr$(R + 48) Else Digit$ = Chr$(R + 55)
N$ = Right$(Digit$, 1) + N$
D = D \ Nb
Loop
ConvertBase$ = N$
End Function

Sub CopyFile(src As String, dst As String, TotalSize, xssx As Label, Percent As Integer)
Path1$ = src
path2$ = dst
If Not FileExist(Path1$) Then MsgBox "File not found: " + Path1$: GoTo 1101
If FileExist(path2$) And UCase$(LastPart$(path2$, "\")) <> "VB40032.DLL" Then Kill path2$
total = TotalSize
Open Path1$ For Binary As #1
Open path2$ For Binary As #2
Per1 = Percent
incc = (LOF(1) / total) * 100
Dim ff As String * 10000
For Q = 1 To LOF(1)
Percent = ((Q / LOF(1)) * incc) + Per1
If Percent > lstper Then xssx.Caption = RTrim$(LTrim$(Str$(Percent))): lstper = Percent
Get #1, , ff
If Q + Len(ff) > LOF(1) Then gg$ = Mid$(ff$, 1, (LOF(1) - Q) + 1): Put #2, , gg$ Else Put #2, , ff
sx = DoEvents()
Q = Q + Len(ff$) - 1
Next Q
1101 Close 1, 2
End Sub

Sub CreateDDELink(topi$, exec$, ddelnk As Label)
On Error Resume Next
ddelnk.LinkTopic = topi$
ddelnk.LinkMode = 2
For qqq = 1 To 100
xx = DoEvents()
Next qqq
ddelnk.LinkTimeout = 100
ddelnk.LinkExecute exec$
ddelnk.LinkMode = 0
ddelnk.LinkTimeout = 50
End Sub

Sub CreateProgGroup(nme$, Fnm$, ddelnk As Label)
On Error Resume Next
ddelnk.LinkTopic = "ProgMan|Progman"
ddelnk.LinkMode = 2
For qqq = 1 To 100
xx = DoEvents()
Next qqq
ddelnk.LinkTimeout = 100
ddelnk.LinkExecute "[CreateGroup(" + nme$ + "," + Fnm$ + ")]"
ddelnk.LinkMode = 0
ddelnk.LinkTimeout = 50
End Sub

Sub CreateProgItem(fm$, nme$, Destin As String, ddelnk As Label)
On Error Resume Next
For Q = 1 To Len(fm$)
If Mid$(fm$, Q, 2) = "*1" Then Q = Q + 1: Fnm$ = Fnm$ + Destin Else Fnm$ = Fnm$ + Mid$(fm$, Q, 1)
Next Q
ddelnk.LinkTopic = "ProgMan|Progman"
ddelnk.LinkMode = 2
For qqq = 1 To 500
z% = DoEvents()
Next qqq
ddelnk.LinkTimeout = 100
ddelnk.LinkExecute "[AddItem(" + Fnm$ + "," + nme$ + ",,,)]"
'For qqq = 1 To 500
'z% = DoEvents()
'Next qqq
ddelnk.LinkMode = 0
ddelnk.LinkTimeout = 50
End Sub


Sub Draw3DLine(X1, Y1, X2, Y2, X As Form)
On Error Resume Next
X.AutoRedraw = True
If X.BackColor <> QBColor(7) Then X.BackColor = QBColor(7)
If Y1 = Y2 Then Chk2 = 20
If X1 = X2 Then chk1 = 20
If X1 <> X2 And Y1 <> Y2 Then chk1 = 20
X.Line (X1, Y1)-(X2, Y2), QBColor(8)
X.Line (X1 + chk1, Y1 + Chk2)-(X2 + chk1, Y2 + Chk2), QBColor(15)
End Sub

Sub DrawFormBack(mm As Form)
xx = 255
vin = mm.Width
vass = (254 / vin)
xzxz = mm.DrawWidth
For Q = 0 To vin Step xzxz
mm.Line (Q, 0)-(Q, mm.Height), RGB(0, 0, xx)
xx = xx - (vass * xzxz)
Next Q
mm.Refresh
End Sub

Sub DrawGoodBack(mm As Control)
xx = 255
vin = mm.Width
vass = (254 / vin)
xzxz = mm.DrawWidth
For Q = 0 To vin Step xzxz
mm.Line (Q, 0)-(Q, mm.Height), RGB(0, 0, xx)
xx = xx - (vass * xzxz)
Next Q
mm.Refresh
End Sub

Sub DrawGraph(N, X As PictureBox)
If X.AutoRedraw = 0 Then X.AutoRedraw = True
PerCen = Int((SizeOfCircle / 100) * N)
SizeOfCircle = WhichIsGreater(X.Width * -1, X.Height * -1) * -1
X.FillStyle = 0: X.FillColor = RGB(127, 0, 127)
X.Circle (Int(X.Width / 2), Int(X.Height / 2)), Int(SizeOfCircle / 2), QBColor(0), , , 0.45
X.FillStyle = 0: X.FillColor = RGB(255, 0, 255)
X.Circle (Int(X.Width / 2), Int(X.Height / 2) - 120), Int(SizeOfCircle / 2), QBColor(0), , , 0.4
X.Line (Int(X.Width / 2), Int(X.Height / 2) - 120)-(Int(X.Width / 2) - Int(SizeOfCircle / 2), Int(X.Height / 2) - 120)
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)
End Sub

Sub DrawPerBar(X As Integer, Where As PictureBox, ForeColor As Long)
If Where.AutoRedraw = False Then Where.AutoRedraw = True
Where.Cls
If Where.BorderStyle = False Then BordOr3D = False
If Where.Appearance = 1 Then BordOr3D = 2
Where.Line (10, 10)-Step(((Where.Width - 35) / 100) * X, Where.Height - 75 + (((BordOr3D - 1) * -1) * 30)), ForeColor, BF
End Sub

Sub DrawPercentBar(X As Integer, Where As PictureBox)
Spacen = 55 'Int((Where.Width / 100))
'xz = Int(300 / 6)
If X Mod (Where.Width / 980) = 0 Then
'If x Mod 6 = 0 Then
Where.Line ((X * Spacen) - 254, 15)-Step(254, 250), QBColor(1), BF
End If
End Sub

Function FileExist(filename As String)
On Error Resume Next
Open filename For Input As #7
If Err <> 0 Then
    FileExist = False
Else
    FileExist = True
End If
Close 7
End Function

Function Fixed$(Txt$)

If Left$(Txt$, 1) = " " Or Left$(Txt$, 1) = "\" Then Txt$ = Left$(CurDir$, 1) + Txt$
For Q = 1 To Len(Txt$)
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)
Next Q
mm$ = LTrim$(RTrim$((mm$)))
If Right$(mm$, 1) = "\" Then Else mm$ = mm$ + "\"
If Mid$(Txt$, 2, 1) <> ":" Then mm$ = Left$(Txt$, 1) + ":" + Right$(Txt$, Len(Txt$) - 1)
If Mid$(mm$, 3, 1) <> "\" Then mm$ = Left$(mm$, 2) + "\" + Right$(mm$, Len(mm$) - 2)
For Q = 1 To Len(mm$)
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)
Next Q
For Q = 1 To Len(mmm$)
If Mid$(mmm$, Q, 1) = "\" And PastMM$ = "\" Then mmm$ = Left$(mmm$, Q - 1) + Right$(mmm$, Len(mmm$) - Q): Q = Q - 1
PastMM$ = Mid$(mmm$, Q, 1)
Next Q
Fixed$ = mmm$
End Function

Function GetWindowsDir$()
temp$ = String$(145, 0)
X = GetWindowsDirectory(temp$, 145)
temp$ = Left$(temp$, X)
If Right$(temp$, 1) <> "\" Then GetWindowsDir$ = temp$ + "\" Else GetWindowsDir$ = temp$
End Function

Function GetWindowsSysDir$()
temp$ = String$(145, 0)
X = GetSystemDirectory(temp$, 145)
temp$ = Left$(temp$, X)
If Right$(temp$, 1) <> "\" Then GetWindowsSysDir$ = temp$ + "\" Else GetWindowsSysDir$ = temp$
End Function

Sub IfExistMkDir(Drr$)
If ExistDir(Drr$) = False Then MkDir (Drr$)
End Sub

Function IfLessThan(n1, n2)
If n1 < n2 Then IfLessThan = n1
End Function

Function LastPart$(t$, s$)
For Q = Len(t$) To 1 Step -1
If Mid$(t$, Q, 1) = s$ Then Exit For Else ddd$ = Mid$(t$, Q, 1) + ddd$
Next Q
LastPart$ = ddd$
End Function


Sub Make3DLine(X As Line)
X1 = X.X1
X2 = X.X2
Y1 = X.Y1
Y2 = X.Y2
On Error Resume Next
X.Parent.AutoRedraw = True
If X.Parent.BackColor <> QBColor(7) Then X.Parent.BackColor = QBColor(7)
If Y1 = Y2 Then Chk2 = 20
If X1 = X2 Then chk1 = 20
If X1 <> X2 And Y1 <> Y2 Then chk1 = 20
X.BorderColor = QBColor(8)
X.Parent.Line (X1 + chk1, Y1 + Chk2)-(X2 + chk1, Y2 + Chk2), QBColor(15)
End Sub

Sub Make4Style(X As Form)
If X.BorderStyle <> 0 Then Exit Sub
X.Line (0, 0)-(0, X.Height - 20), QBColor(7)
X.Line (15, 15)-(15, X.Height - 15), QBColor(15)
X.Line (35, 15)-(35, X.Height - 15), QBColor(7)
X.Line (0, X.Height - 15)-(X.Width - 0, X.Height - 15), QBColor(0)
X.Line (15, X.Height - 35)-(X.Width - 15, X.Height - 35), QBColor(8)
X.Line (15, X.Height - 50)-(X.Width - 15, X.Height - 50), QBColor(7)
X.Line (X.Width - 10, 0)-(X.Width - 10, X.Height), QBColor(0)
X.Line (X.Width - 30, 15)-(X.Width - 30, X.Height - 15), QBColor(8)
X.Line (X.Width - 45, 15)-(X.Width - 45, X.Height - 15), QBColor(7)
X.Line (0, 0)-(X.Width, 0), QBColor(7)
X.Line (15, 15)-(X.Width - 15, 15), QBColor(15)
X.Line (35, 35)-(X.Width - 35, 35), QBColor(7)

End Sub

Sub MakeFormFloat(X As Form, f%)
junls = SetWindowPos%(X.hWnd, f%, 0, 0, 0, 0, 3)
End Sub

Function MakeLength$(tx$, nm, f$)
If Len(tx$) >= nm Then MakeLength$ = tx$: Exit Function
MakeLength$ = String$(nm - Len(tx$), f$) + tx$
End Function

Sub MkDirr(Dr$)
Drvv$ = Left$(Dr$, 2)
On Error Resume Next
For Q = 1 To Len(Dr$)
If Mid$(Dr$, Q, 1) = "\" And dd = 1 Then dd = 0: IfExistMkDir (Drvv$ + "\" + xx$): xx$ = xx$ + "\"
If Mid$(Dr$, Q, 1) = "\" And dd = 0 Then dd = 1
If Mid$(Dr$, Q, 1) <> "\" And dd = 1 Then xx$ = xx$ + Mid$(Dr$, Q, 1)
Next Q
If ExistDir(Drvv$ + "\" + xx$) = False Then MkDir (Drvv$ + "\" + xx$)
End Sub

Function NumOfOccurs(Txt$, s$)
If Mid$(Txt$, 1, 1) <> "»" Then Txt$ = "»" + Txt$
For Q = 1 To Len(Txt$)
If Mid$(Txt$, Q, 1) = s$ Then dds = dds + 1
Next Q
NumOfOccurs = dds
End Function

Function PartsOfString(t$, l$)
For aa = 1 To Len(t$)
If UCase$(Mid$(t$, aa, Len(l$))) = UCase$(l$) Then i = i + 1
Next aa
PartsOfString = i
End Function

Sub PlayWav(wav$)
SND_SYNC = &H0
SND_ASYNC = &H1
SND_NODEFAULT = &H2
SND_LOOP = &H8
SND_NOSTOP = &H10
wFlags% = SND_ASYNC Or SND_NODEFAULT
X% = sndPlaySound(wav$, wFlags%)
End Sub

Sub SelectAll(X As TextBox)
X.SelStart = 0
X.SelLength = Len(X.Text)
End Sub

Function StrToInt(t$)
For Q = 1 To Len(t$)
dd$ = MakeLength$(Hex$(Asc(Mid$(t$, Q, 1))), 2, "0") + dd$
Next Q
StrToInt = Val("&H" + dd$)
End Function

Function SwitchUp(ByVal n1, ByVal n2, ByVal n3)
If n1 = n2 Then SwitchUp = n3 Else SwitchUp = n2
End Function

Function TRIMS$(n1)
TRIMS$ = LTrim$(RTrim$(Str$(n1)))
End Function

Function TypeOfDir$(Vld$, Pth$)
If UCase$(Vld$) = "INVAILD DIRECTORY" Then TypeOfDir$ = Vld$: Exit Function
If Right$(Pth$, 1) = "\" Then Else Pth$ = Pth$ + "\"
If Right$(UCase$(Pth$), 2) = ":\" Then TypeOfDir$ = "Root Directory": Exit Function
If UCase$(GetWindowsDir$()) = UCase$(Pth$) Then TypeOfDir$ = "Windows Directory (" + WindowsVersion$() + ")": Exit Function
If UCase$(GetWindowsSysDir$()) = UCase$(Pth$) Then TypeOfDir$ = "Windows SYSTEM Directory  (" + WindowsVersion$() + ")": Exit Function
If PartsOfString(Pth$, "\") = 2 Then TypeOfDir$ = "Root Directory Entry" Else TypeOfDir$ = "Sub Directory"
End Function

Sub Unpack(Path1$, path2 As String, TotalSize, xdx As Label, Percent As Integer)
Pack$ = Path1$
nl$ = Chr$(13) + Chr$(10)
On Error Resume Next
Err = 0
Open Pack$ For Binary As #2
If Err <> 0 Then MsgBox "File Not Found: " + Pack$: Exit Sub
Dim ff As String * 100
Dim nme As String * 12
Dim nth As String * 1
Dim sz As Single
Dim Percn As Integer
Percn = 1
total = TotalSize
Do Until Loc(2) >= LOF(2)
Per1 = Percent
Get #2, , nme
flnm$ = RTrim$(LTrim$(nme))
Get #2, , sz
filsiz = sz
If flnm$ = "123456789012" Then GoTo 1231
'Form3.Label1.Caption = "Source:" + nl$ + Pack$ + nl$ + nl$ + "Destination:" + nl$ + path2 + flnm$
If FileExist(path2 + flnm$) Then Kill (path2 + flnm$)
Open path2 + flnm$ For Binary As #1
For mm = 0 To filsiz - 1
If (mm / total) * 100 < 0 Then Stop
Get #2, , ff
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
Percent = ((mm / (total)) * 100) + Per1
If Percn <> Percent Then Percn = Percent: xdx.Caption = LTrim$(RTrim$(Str$(Percn)))
mm = (mm + Len(ff)) - 1
X = DoEvents()
Next mm
Close 1
Loop
1231 Close 1, 2, 4, 5, 6, 7, 8, 9
End Sub

Function WhichIsGreater(p1, p2)
If p1 > p2 Then WhichIsGreater = p1 Else WhichIsGreater = p2
End Function

Function WindowsVersion$()
TheVerInfo& = GetVersion()
WinVer& = TheVerInfo& And &HFFFF&
xxss$ = RTrim$(LTrim$(Str$(WinVer& Mod 256))) + "." + RTrim$(LTrim$(Str$(WinVer& \ 256)))
If Val(xxss$) = 3.95 Then WindowsVersion$ = "Windows 95" Else WindowsVersion$ = "Windows " + xxss$
If Mid$(xxss$, 1, 3) = "3.5" Then WindowsVersion$ = "Windows NT"
End Function