Compilation error in hidden module: Protect_All

M

Max

Hi all.
I have built an application that requires a module to protect itself;
it expires after 40 sessions of work. Some customer of mine told me
that they have a compilation error in that module, but in my PC I
can't see nothing.

Can someone help me?

Here's the module: I have substituted some string with "mio.....".
You can see and test the complete application downloading it from:
http://win.piccioli.com/cranesuite/cranesuite_11.exe

Note that the modules (Protect_All) is used in all the 3 application,
but my customers told me that the error occurs in only one each, and
not always the same.
Hope to be clear, sorry for my bad english
Thanks in advance, Massimiliano Piccioli



***************************************************************

Public Type GenrlType
InnerRec As String * 16
End Type
Public GenrlRec As GenrlType

Public Type SmallType
InnerRec As String * 2
End Type
Public SmallRec As SmallType

Declare Function GetSystemDirectoryA Lib "kernel32" _
(ByVal lpbuffer As String, ByVal nsize As Long) As Long

****************************************************************

Sub CheckUser()

Dim PTF As String
Dim GetYa As Long
Dim GetY1 As Long
Dim GetY2 As Long
Dim MyOut As String
Dim MyIn As String
Dim Tmp1 As String
Dim DDog As Variant
Dim ODog As Variant
Dim strPath As String, SysDir As String
strPath = Space(255)
SysDir = Left(strPath, GetSystemDirectoryA(strPath, Len(strPath)))
PTF = SysDir
PTF = PTF + "miofile"
PTF = UCase$(PTF)

DDog = Date
ODog = Time

Date = "miodate"
Time = "miotime"
On Error GoTo NewUser
Open PTF For Input Access Read As #11
Close #11
On Error GoTo 0
Open PTF For Binary Access Read As #11
Get #11, &H230, GenrlRec
Close #11
MyIn = GenrlRec.InnerRec
GetYa = Asc(Mid$(MyIn, 5, 1))
GetYa = GetYa * 256
GetYa = GetYa + Asc(Mid$(MyIn, 6, 1))
If GetYa > 32767 Then GetYa = GetYa - 65536
If GetYa = &HEFEF Then GoTo EndUser
If GetYa = &H37 Then GoTo Expired
GetYa = GetYa + 1
If GetYa < 0 Then GetYa = 65536 + GetYa
MyOut = Chr$(Int(GetYa / 256))
MyOut = MyOut + Chr$(GetYa Mod 256)
SmallRec.InnerRec = MyOut
Open PTF For Binary Access Write As #11
Put #11, &H234, SmallRec
Close #11
GoTo EndUser
NewUser:
On Error GoTo 0
MyOut = "mioout"
Open PTF For Binary Access Write As #11
Put #11, , MyOut
MyOut = Chr$(Val(Left$(DDog, 2)))
MyOut = MyOut + Chr$(Val(Mid$(DDog, 4, 2)))
GetY1 = Int(Val(Mid$(DDog, 7, 4)) / 256)
GetY2 = Val(Mid$(DDog, 7, 4)) Mod 256
MyOut = MyOut + Chr$(GetY1) + Chr$(GetY2)
MyOut = MyOut + Chr$(&H0) + Chr$(&H10)
MyOut = MyOut + Chr$(&H0) + Chr$(&H1)
MyOut = MyOut + Chr$(&H0) + Chr$(&H1)
MyOut = MyOut + Chr$(&H0) + Chr$(&H0) + Chr$(&H0) +
Chr$(&H0) + Chr$(&H0) + Chr$(&H0)
GenrlRec.InnerRec = MyOut
Put #11, &H230, GenrlRec
Close #11
Date = DDog
Time = ODog
MsgBox ("miomex")
GoTo MySubEnd
Expired:
Date = DDog
Time = ODog

MSG = ("miomex")

choice = MsgBox(MSG, vbYesNo)

If choice = vbYes Then
Call RelCo(code, pass)
MSGA = "miomexA"
MSGB = "miomexB"
MEX = MSGA & Chr(13) & code & Chr(13) & MSGB
PW = InputBox(MEX)
Else
ThisWorkbook.Close
End If
If PW = pass Or PW = "miopwd" Then
GetYa = &HEFEF
If GetYa < 0 Then GetYa = 65536 + GetYa
MyOut = Chr$(Int(GetYa / 256))
MyOut = MyOut + Chr$(GetYa Mod 256)
SmallRec.InnerRec = MyOut

DDog = Date
ODog = Time

Date = "miodate"
Time = "miotime"

Open PTF For Binary Access Write As #11
Put #11, &H234, SmallRec
Close #11

Date = DDog
Time = ODog

MsgBox ("miomex")
GoTo MySubEnd
Else
MsgBox ("miomex")
ThisWorkbook.Close
End If
EndUser:
Date = DDog
Time = ODog
MySubEnd:
End Sub

***************************************************************

Sub RelCo(code, pass)
Dim PC, SC, UC As String
Dim Lungh As Integer
Dim STR As String
Dim MyCode As String
On Error GoTo NoSTR
STR = Environ("computername")
Lungh = Len(STR)
PC = Left(STR, 1)
If Lungh < 2 Then
SC = "X"
Else
SC = Mid(STR, 2, 1)
End If
UC = Right(STR, 1)
MyCode = "CS10" & (Hex(Asc(PC) - 13)) & "S" & (Hex(Asc(SC) + 17)) &
"U" & (Hex(Asc(UC) + 13))
MyCode = UCase$(MyCode)
MyPass = (Asc(PC) + 57) & (Asc(SC) * 3) & (Asc(UC) * 2)
GoTo MyEnd
On Error GoTo 0
NoSTR:
MyCode = "miocode"
MyPass = "miopwd"
MyEnd:
code = MyCode
pass = MyPass
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top