...

View Full Version : eVB for Pocket PC



AwaKening
07-16-2008, 09:34 PM
I'm pretty proficient at scripting with vbs and was hoping there was a way to run eVB as a standalone program on the pocket PC since vbs doesn't work. If I try saving the following code with a .vb extension or .evb extension, it won't work. What do I need to do to get this to work, keeping in mind I know nothing about Forms.


Public Const title = "Results"
Public Const tFolder = "\Results"

Public m_FileObject As FILECTLCtl.File

Call CreateFile(tFolder)


Public Sub CreateFile(Path As String)
Dim filFile As FILECTLCtl.File
Dim Contents As String
Dim tn As String
Dim techid As String
Dim Response As String

On Error Resume Next

Set filFile = GetFileObject()

Do While tn = vbNullString
tn = InputBox("Enter Telephone Number", title)
If tn = vbNullString Then
Exit Sub
ElseIf Len(tn)<10 Then
tn = vbNullString
End If
Loop

Do While techid = vbNullString
techid = InputBox("Enter Your ID", title, "000000")
If techid = vbNullString Then
Exit Sub
ElseIf techid = "000000" Or Len(techid)<6 Then
techid = vbNullString
End If
Loop

Response = MsgBox("Enter your own results?", vbYesNo)
If Response = vbYes Then
Contents = CreateOwnTest(tn, techid)
Else
Contents = CreateTest(tn, techid)
End If

If Contents = vbNullString Then
MsgBox "The file could not be created.", vbCritical, "Error"
Set filFile = Nothing
Call ReleaseFileObject()
Exit Sub
End If

' Open the file, if it doesn't exist, it will be created
' fsModeOutput means overwrite
filFile.Open Path & tn & ".dat", fsModeOutput, fsAccessWrite, fsLockWrite

' Make sure the call to Open was successful
If Err.Number <> 0 Then
MsgBox "Open Method failed." & vbCrLf & "The file could not be created.", vbCritical, "Error"
filFile.Close
Set filFile = Nothing
Call ReleaseFileObject()
Exit Sub
End If

' Write our data to the file if it's not empty
If Contents <> "" Then
filFile.LinePrint Contents
End If

' Close the file
filFile.Close

' Release the File Object
Set filFile = Nothing

Call ReleaseFileObject()
End Sub

Public Function CreateTest(tn, techid)
Dim Results As String

Randomize

Results = Results & "Technician ID:" & techid & vbCrLf
Results = Results & "Number Tested: " & tn
Results = Results & "Test Date: " & Date() & " " & FormatDateTime(Now(),4) & vbCrLf
Results = Results & "Before DIAL IN" & vbCrLf
Results = Results & "AC, 0.00,0.00,0.00,P" & vbCrLf
Results = Results & "DC, 0.00,-51.,51.6,P" & vbCrLf
Results = Results & "mA," & FormatNumber(((30 - 27) * Rnd + 26),1) & ",P" & vbCrLf
Results = Results & "After DIAL IN" & vbCrLf
Results = Results & "AC, , , ,U" & vbCrLf
Results = Results & "DC, , , ,U" & vbCrLf
Results = Results & "OPEN, , , ,U" & vbCrLf
Results = Results & "LEAK, , , ,U" & vbCrLf
Results = Results & "LRES, ,U" & vbCrLf
Results = Results & "GRES, , , ,I" & vbCrLf
Results = Results & "LOSS,-" & FormatNumber(((8 - 6) * Rnd + 5),1) & ",P" & vbCrLf
Results = Results & "NOISE," & FormatNumber(((8 - 4) * Rnd + 3),2) & ",P" & vbCrLf
Results = Results & "PI," & FormatNumber(((65 - 61) * Rnd + 60),1) & ",P" & vbCrLf
Results = Results & "LB," & FormatNumber(((75 - 69) * Rnd + 68),1) & ",P" & vbCrLf
Results = Results & "LOAD" & Space(20) & "0" & vbCrLf
Results = Results & "L"

CreateTest = Results
End Function

Public Function CreateOwnTest(tn, techid)
Dim mA As String
Dim LOSS As String
Dim NOISE As String
Dim PI As String
Dim LB As String
Dim Results As String

CreateOwnTest = vbNullString

mA = InputBox("Loop current mA", title, "27.9")
If mA = vbNullString Then
Exit Function
End If

LOSS = InputBox("Loop Loss (include -)", title, "-7.3")
If LOSS = vbNullString Then
Exit Function
End If

NOISE = InputBox("Line Noise (db)", title, "7.87")
If NOISE = vbNullString Then
Exit Function
End If

PI = InputBox("Power Influence", title, "61.9")
If PI = vbNullString Then
Exit Function
End If

LB = InputBox("Longitudinal Balance", title, "69.7")
If LB = vbNullString Then
Exit Function
End If

Results = Results & "Technician ID:" & techid & vbCrLf
Results = Results & "Number Tested: " & tn & vbCrLf
Results = Results & "Test Date: " & Date() & " " & FormatDateTime(Now(),4) & vbCrLf
Results = Results & "Before DIAL IN" & vbCrLf
Results = Results & "AC, 0.00,0.00,0.00,P" & vbCrLf
Results = Results & "DC, 0.00,-51.,51.6,P" & vbCrLf
Results = Results & "mA," & mA & ",P" & vbCrLf
Results = Results & "After DIAL IN" & vbCrLf
Results = Results & "AC, , , ,U" & vbCrLf
Results = Results & "DC, , , ,U" & vbCrLf
Results = Results & "OPEN, , , ,U" & vbCrLf
Results = Results & "LEAK, , , ,U" & vbCrLf
Results = Results & "LRES, ,U" & vbCrLf
Results = Results & "GRES, , , ,I" & vbCrLf
Results = Results & "LOSS," & LOSS & ",P" & vbCrLf
Results = Results & "NOISE," & NOISE & ",P" & vbCrLf
Results = Results & "PI," & PI & ",P" & vbCrLf
Results = Results & "LB," & LB & ",P" & vbCrLf
Results = Results & "LOAD" & Space(20) & "0" & vbCrLf
Results = Results & "L"

CreateOwnTest = Results
End Function


Public Function GetFileObject() As FILECTLCtl.File
On Error Resume Next

If IsEmpty(m_FileObject) Then
Set m_FileObject = CreateObject("FILECTL.File")
' Ensure the object was created successfully
If Err.Number <> 0 Then
MsgBox "Failed to create File object." & vbCrLf & _
"Ensure MSCEFile.dll has been installed and registered.", _
vbCritical, "Error"
Exit Function
End If
End If

' Return our global File object
Set GetFileObject = m_FileObject
End Function


Public Sub ReleaseFileObject()
Set m_FileObject = Nothing
End Sub



EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum