VB 6 Problem on WindowsNT

[Mac]

What I don't understand is that this program works fine for many days, but from time to time, inexplicitely gives an error "". Could it be my Always_On_Top Sub? It seems standard enough to me.

What happens (I think it is after I use Netscape) is that when I click, I get
Run-time error '70':
Permission denied

What I should get is that the URL I am referencing comes up on IE.

When I bring up the program and click again, it works fine.

???

Mac

Form1
========================================
[code]
Option Explicit
Dim RunMode As Integer
Const RunModeFile As String = "CallURL.mod"
Const NoBlank As Integer = 160: 'Value to use to replace blanks
'Const NoBlank As Integer = 94: 'Alternate during debugging
Dim OldClip As String
Dim TextSize As Long

Private Sub Form_Activate()
If IsURL Then
cmdTry.SetFocus
ElseIf InStr(Text1.Text, " ") > 0 Then
cmdExit.SetFocus
Else
cmdNOP.SetFocus
End If
Call Always_On_Top(Form1.hwnd)
End Sub

Private Sub Form_Load()
If App.PrevInstance Then
MsgBox "Another instance is running", vbCritical, "Adios"
End
End If
Dim L As String
Dim MSG As String
MSG = "File " + RunModeFile + " is missing or invalid"
RunMode = 0
If Dir(RunModeFile) = "" Then
L = GetRunMode(MSG)
Else
Open RunModeFile For Input As #1
If EOF(1) Then
L = GetRunMode(MSG)
Else
Input #1, L
L = Left$(LTrim$(L), 1)
If InStr("0123", L) = 0 Then L = GetRunMode(MSG)
End If
Close
End If
RunMode = Val(L)

' Temporary debug edits
Dim td3 As Boolean
If RunMode < 0 Then td3 = True
If RunMode > 3 Then td3 = True
If RunMode = 0 Then If L <> "0" Then td3 = True
If td3 Then MsgBox "runmode error": Stop
MSG = ""
' When finished debugging, add "create file"
' End

Clipboard_to_Text

If RunMode = 0 Then Exit Sub

If cmdDoubleDo = 2 Then
MSG = "Here is some of the clipboard:"
MSG = MSG + vbLf + Left$(Clipboard.GetText, 70)
MSG = MSG + vbLf + vbLf
MSG = MSG + vbLf + " The clipboard will have double spaces"
MSG = MSG + " removed, ready to paste in the QBasic forum"

If RunMode = 1 Then
If MsgBox(MSG, vbOKCancel) = vbOK Then ChangeClipboardExit
End If

If RunMode = 2 Then
If MsgBox("Changing Clipboard Text", vbOKCancel) = vbOK Then
ChangeClipboardExit
End If
End If

If RunMode <> 3 Then Exit Sub

If MsgBox(MSG, vbOKCancel) = vbOK Then ChangeClipboardExit: Stop
Text1.Text = Clipboard.GetText
Exit Sub
End If

If RunMode = 2 Then
MSG = "Nothing legal to do. Terminate Immediately?"
If MsgBox(MSG, vbYesNo) = vbYes Then End
End If

If RunMode = 1 And MSG = "" Then
If IsURL Then XferToIE Text1.Text: End
End If
End Sub

Private Sub cmdClear_Click()
Clipboard.Clear
Text1.Text = ""
Text1.SetFocus
End Sub

Private Sub cmdDouble_Click()
If cmdDoubleDo = 2 Then
Clipboard.Clear
Clipboard.SetText Text1.Text
End
End If
MsgBox "No double-spaces or leading spaces"
End Sub

Private Function cmdDoubleDo() As Integer
Dim w As String
w = Text1.Text + "x"
If InStr(w, Chr$(9)) > 0 Then
Dim MSG As String
MSG = "At least one TAB character detected in input"
MSG = MSG + vbLf + vbLf
MSG = MSG + "How many spaces do you want a TAB to equal?"
MSG = MSG + vbLf + vbLf
MSG = MSG + "If you enter other than a number in the range"
MSG = MSG + " 0-10 (or nothing) then you will be prompted again."
MSG = MSG + vbLf + vbLf
MSG = MSG + "(0 or nothing means to leave the TAB unchanged)"
Dim v As Integer, u As String
Do
u = InputBox(MSG, "TAB Problem")
Select Case Len(u)
Case 0: v = 0
Case 1:
If u = "0" Then
v = 0
Else
If InStr("123456789", u) > 0 Then
v = Val(u)
Else
v = -1
End If
End If
Case 2:
If u = "10" Then v = 10 Else v = -1
Case Else: v = -1
End Select
Loop While v < 0
If v > 0 Then
w = ""
Dim j As Integer, c As String * 1
For j = 1 To Len(Text1.Text)
c = Mid$(Text1.Text, j, 1)
If c = Chr$(9) Then
w = w + Space$(v)
Else
w = w + c
End If
Next j
w = w + "x"
End If
End If
Dim i As Long
Dim Changes As Boolean
For i = 1 To Len(w) - 1
c = Mid$(w, i, 1)
If c = " " Then GoSub FixIt
Next i
If Not Changes Then
If InStr(w, Chr$(13) + Chr$(10)) = 0 Then
cmdDoubleDo = 0
Else
cmdDoubleDo = 1
End If
Exit Function
End If
Text1.Text = Left$(w, Len(w) - 1)
cmdDoubleDo = 2
Exit Function

FixIt:
Dim Problem As Boolean
Problem = False
If i = 1 Then
Problem = True ' Leading space on line 1
ElseIf Asc(Mid$(w, i - 1, 1)) = 10 Then
Problem = True ' Leading space on other lines
ElseIf Mid$(w, i + 1, 1) = " " Then
Problem = True ' There is a double space
End If
If Not Problem Then Return
Changes = True
Do While c = " "
Mid$(w, i, 1) = Chr$(NoBlank)
i = i + 1
c = Mid$(w, i, 1)
Loop
Return
End Function

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdHelp_Click()
Const ReadMe As String = "CallURL_Read_Me.txt"
Dim MSG As String
If Dir(ReadMe) = "" Then
MSG = "You lost your read-me file, " + ReadMe
MSG = MSG + vbLf
MSG = MSG + vbLf + "Try downloading again"
MSG = MSG + vbLf + "(See QBasic Forum links)"
MsgBox MSG
Exit Sub
End If
Shell "notepad " + ReadMe, vbMaximizedFocus
End Sub

Private Sub cmdNOP_Click()
MsgBox "Select desired option"
cmdNOP.SetFocus
End Sub

Private Sub cmdRunMode_Click()
RunMode = Val(GetRunMode("Change Run Mode"))
End Sub

Private Sub cmdTry_Click()
Dim MSG As String
If Not IsURL Then
MSG = "Not a recognized URL - Submit it anyway?"
If MsgBox(MSG, vbYesNo) = vbNo Then Exit Sub
End If
XferToIE Text1.Text
End Sub

Private Function IsURL() As Boolean
IsURL = True
Dim L As String: L = UCase$(Text1.Text)
If Left$(L, 7) = "HTTP://" Then Exit Function
If Left$(L, 8) = "HTTPS://" Then Exit Function
If Left$(L, 4) = "WWW." Then
Text1.Text = "http://" + Text1.Text
Exit Function
End If
IsURL = False
End Function

Private Sub XferToIE(URL As String)
Call DoShell(URL)
End
End Sub

Function GetRunMode(MSG0 As String) As String
Dim OldVal As String
OldVal = LTrim$(Str$(RunMode))
Dim MSG As String
MSG = MSG + vbLf + "If you know what run mode you want,"
MSG = MSG + "enter it now. "
MSG = MSG + vbLf + "Or CANCEL to select " + OldVal
MSG = MSG + vbLf
MSG = MSG + vbLf + "Run Modes are"
MSG = MSG + vbLf + "-0- Always bring up GUI"
MSG = MSG + vbLf + "-1- Only bring up GUI if Clipboard does"
MSG = MSG + " not contain a legal URL or text with double blanks"
MSG = MSG + vbLf + "-2- Same as -1- except option to avoid GUI"
MSG = MSG + vbLf + "-3- Always confirm before doing something"
MSG = MSG + vbLf
MSG = MSG + vbLf + "You can always change this later via"
MSG = MSG + " the GUI (click on MORE there)"
MSG = MSG + vbLf
MSG = MSG + vbLf + "Read the ReadMe for more details"
Dim L As String
Do
L = InputBox(MSG, MSG0, OldVal)
If L = "" Then L = OldVal
L = Left$(LTrim$(L), 1)
If InStr("0123", L) = 0 Then MSG = "Enter only 0,1,2,or 3"
Loop While InStr("0123", L) = 0
Open "CallURL.mod" For Output As #1
Print #1, L
Close
GetRunMode = L
End Function

Sub ChangeClipboardExit()
Clipboard.Clear
Clipboard.SetText Text1.Text
End
End Sub

Private Sub Text1_Change()
If Len(Text1.Text) < TextSize Then Timer1.Enabled = False
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
Timer1.Enabled = False
If KeyAscii = 27 Then
If OldClip = Text1.Text Then
OldClip = "": Clipboard_to_Text
Else
Text1.Text = OldClip
End If
Exit Sub
End If
If KeyAscii <> 13 Then Exit Sub
Clipboard.Clear
Clipboard.SetText Text1.Text
Call cmdTry_Click
End Sub

Private Sub Timer1_Timer()
Clipboard_to_Text
End Sub

Private Sub Clipboard_to_Text()
Dim NewClip As String
NewClip = Clipboard.GetText
If NewClip = OldClip Then Exit Sub
OldClip = NewClip
Timer1.Enabled = False
Text1.Text = Clipboard.GetText
TextSize = Len(Text1.Text)
If TextSize > 65534 Then
MsgBox "Program too big. Will do as much as I can"
End If
Timer1.Enabled = True
End Sub
[/code]

Module1
========================================
[code]
Option Explicit
Public strIE As String ' Where the Internet Explorer is
Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long _
) As Long

Public Sub DoShell(URL As String)
Dim fleDat As String: fleDat = App.Path + "\CallURL.DAT"
If Dir(fleDat) = "" Then
Open fleDat For Output As #1
Print #1, "C:\Program Files\Internet Explorer\iexplore.exe"
Close
End If
GoSub GetIE
Shell strIE + " " + URL, vbNormalFocus
Exit Sub

GetIE:
Open fleDat For Input As #1
Line Input #1, strIE
Close
If Dir(strIE) <> "" Then Return
Dim MSG As String
MSG = "OK, Here's the deal:"
MSG = MSG + vbLf
MSG = MSG + vbLf + "I cannot find IEXPLORE or whatever you use"
MSG = MSG + vbLf + "Please find one and enter it here"
MSG = MSG + vbLf
MSG = MSG + vbLf + "This prompt will repeat until you get a valid file"
MSG = MSG + vbLf
Do While Dir(strIE) = ""
strIE = InputBox(MSG, "One-time setup", strIE)
If strIE = "" Then End
Loop
GoSub PutIE
Return

PutIE:
Open fleDat For Output As #1
Print #1, strIE
Close
Return

End Sub

Public Sub Always_On_Top(hwnd As Long)
Dim X As Long
X = SetWindowPos(hwnd, -1, 0, 0, 0, 0, 2 Or 1)
End Sub
[/code]

[k7]

Hmm... Maybe this thread should be moved to the General board, seeing how it's not a QB/FB question as this the forum is intended for. Mac, which do like most; COBOL, VB or QBASIC?

[Mentat]

Mac, I think your [c0de] ... [/c0de] isn't working.

Other than that, VB goes over my head. I tried VB.Net, but all my variables kept on turning into my title.

[Mac]

Hmm... Maybe this thread should be moved to the General board, seeing how it's not a QB/FB question as this the forum is intended for. Mac, which do like most; COBOL, VB or QBASIC?

According to Pete, this forum is for all languages. The general board is probably intended for non-programming issues.

I like VB the most and am sometimes found at the VB Forum:
http://vbforums.com/forumdisplay.php?f=1

However, that forum is so active that all threads scroll off the page immediately, even though they are in order of activity. I try to solve my problems elsewhere since they use such advanced techniques of VB and nearly all API calls. They hardly know what MID$ is and ridicule a construction containing it. Well, "ridicule" is a strong word. They are extremely polite and never engage in any flaming or mutual critisism. Very polite. They do, however, run any post about VB-Net off of their forum. It is for VB6 and below.

Well, I like VB for creating applications that are not appropriate to DOS. If I am in hobby-mode, as opposed to solve-the-problem mode, then I use QB1.0, preferably in SCREEN 0.

Mac

[burger2227]

Ya better get used to them Mac, I hear that VB6 and VISTA don't like each other much.

So hi ho hi ho it's off to .NET we go.

Sounds like one of those errors M$ never fixed...........

Ted