Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all 21634 articles
Browse latest View live

VB6 Common Dialog Control File Open does not give correct folder

$
0
0
I have an application which can be used for different data environments on a single PC.
The application is therefor placed in different folders.

Example:
X:\Software\Radio\Software
X:\Software\Radio\Data
X:\Software\Radio\Data\User\[username]\Reports

X:\Software\TV\Software
X:\Software\TV\Data
X:\Software\TV\Data\User\[username]\Reports

In the application when you choose open/save the CommonDialog is used for selecting an in/output file.
The InitDir property of the CommonDialog is used to jump to the correct location.
Sometime when using the TV environment the statement CD.InitDir = "X:\Software\TV\Data\User\Arnoutdv\Reports" seems to be ignored and the CD opens in "X:\Software\Radio\Data\User\Arnoutdv\Reports"

I've placed logging statements in the Open/Save routines to show the initial path variable and the content of CD.InitDir, even when they both show the correct values the CD opens in the incorrect folder.
It does not happen all of time time and the OS varies from W7 to W10

For my life I can not get it to simulate from the IDE (where I can also choose from multiple data environments).

I found a similar thread on StackOverflow and I've read some forum posts in which is stated that the CommonDialog persists it's own "recent" folders per application somewhere in the registry
Sometimes the CD.InitDir is ignored and a folder from it's "recent used folder" is used for the initial folder.

Thread on vbForums discussing the same problem.

Has anyone ever encountered the same and found a workaround?

[RESOLVED] Detecting when IDE Stop button has been clicked

$
0
0
Ok, I've been adapting all my code to use the "new" (ok, not so new) comctl32.dll method of subclassing. If done with care, I've found that I can actually make my subclassing IDE Stop button safe. That was quite amazing to me, and I'd encourage you to read through my other Subclassing thread for more details on this.

However, my question of the day has to do with detecting when the IDE Stop button has been presses, as opposed to a form just naturally closing. If we're in a compiled program, I won't really care. I'm specifically talking about running programs in the IDE.

Here's a short (BAS) module to illustrate what I'd like to do:

Code:


Option Explicit
'
Private Const WM_DESTROY = &H2&
'
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'
'
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Source As Any, ByVal Bytes As Long)
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type MINMAXINFO
    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI
End Type
'

Public Function IdeStopButton() As Boolean

    ' What might I put here to figure out whether the IDE "Stop"
    ' button was pressed, as opposed to just the form naturally closing.

End Function


Public Sub SubclassFormFixedWidth(frm As VB.Form)
    Call SetWindowSubclass(frm.hWnd, AddressOf FixedWidth_Proc, frm.hWnd, CLng(frm.Width \ Screen.TwipsPerPixelX))
End Sub

Private Function FixedWidth_Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        Call RemoveWindowSubclass(hWnd, AddressOf_FixedWidth_Proc, hWnd)
        FixedWidth_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)


        Debug.Print IdeStopButton


        Exit Function
    End If
    '
    Dim PelWidth As Long
    Dim MMI As MINMAXINFO
    Const WM_GETMINMAXINFO As Long = &H24&
    '
    ' And now we force our width to not change.
    If uMsg = WM_GETMINMAXINFO Then
        ' Force the form to stay at initial size.
        PelWidth = dwRefData
        CopyMemory MMI, ByVal lParam, LenB(MMI)
        MMI.ptMinTrackSize.x = PelWidth
        MMI.ptMaxTrackSize.x = PelWidth
        CopyMemory ByVal lParam, MMI, LenB(MMI)
        Exit Function ' If we process the message, we must return 0 and not let more hook code execute.
    End If
    '
    ' Give control to other hooks, if they exist.
    FixedWidth_Proc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function

Private Function AddressOf_FixedWidth_Proc() As Long
    AddressOf_FixedWidth_Proc = ProcedureAddress(AddressOf FixedWidth_Proc)
End Function

Private Function ProcedureAddress(AddressOf_TheProc As Long)
    ' A private "helper" function for writing the AddressOf_... functions.
    ProcedureAddress = AddressOf_TheProc
End Function

To use it, just throw it into a BAS module and then throw the following into the default Form1's code:

Code:


Option Explicit

Private Sub Form_Load()
    SubclassFormFixedWidth Me
End Sub


It's that IdeStopButton function that I'd like to get working if anyone can figure it out. Even though, when the Stop button is pressed, all COM objects are un-instantiated and all dynamic arrays are erased, that still doesn't give me a way to do it.

Here's one thing I tried, but it didn't work:

Code:


Public Function IdeStopButton() As Boolean
    On Error GoTo Stopping
    Dim bb() As Byte
    ReDim bb(0)
    Exit Function
Stopping:
    IdeStopButton = True
End Function

I also tried this, but no cigar:

Code:


Public Function IdeStopButton() As Boolean
    On Error GoTo Stopping
    Dim coll As Collection
    Set coll = New Collection
    coll.Add "asdf", "asdf"
    Exit Function
Stopping:
    IdeStopButton = True
End Function


Any idea are much appreciated.

Also, I'd like to work this out without any machine-code insertion, but I suppose I'm willing to consider it if nothing else can be worked out.

Elroy

How to get the size of the RTF content from the clipboard ?

$
0
0
How to get the size of the RTF content from the clipboard ?
See below:
Attached Images
 

[RESOLVED] Dynamically loaded RichTextBox can not set scrollbars property.

$
0
0
I need to dynamically add the RichTextBox control on the form, but I can not set some properties of the RichTextBox during runtime, such as Appearance and ScrollBars. The system prompts that these properties are read-only.

Although my new version will use HTML instead of Richtextbox, the existing version still needs to use Richtextbox.

Is there any way to set these read-only properties such as the ScrollBars during runtime? Thanks in advance.

Code:

Option Explicit

Private WithEvents RichTextBox1 As RichTextBox

Private Sub Command1_Click()
    AddRichTextControl
End Sub

Private Sub AddRichTextControl()
    On Error GoTo ErrAdd
   
    Set RichTextBox1 = Me.Controls.Add("RICHTEXT.RichtextCtrl.1", "RichTextBox1")
   
    With RichTextBox1
        '.Appearance = rtfFlat
        '.BorderStyle =rtfNoBorder
        .ScrollBars = rtfBoth
    End With
   
    Exit Sub
   
ErrAdd:
    MsgBox "Load Richtext control failed !" & vbCrLf & vbCrLf & Error
End Sub

Resolved: When Ascii and KeyCode can't distinguish left from right, then what?

$
0
0
G'day guys.
My app relies on key events however neither Ascii nor KeyCode support the distinction of left & right with the "Shift", "Ctrl", "Alt" or "Win" keys.
For example : Left Shift, Right Shift, Left Ctrl, Right Ctrl,.... etc.

Ascii can't even detect the arrow keys and KeyCode isn't much better.
It has to be possible as games made back in 2002 can distinguish left from right with each and every one of those above mentioned keys.

Is there another alternative to Ascii and KeyCode in vb6?

Any help will be appreciated. Thanks.

[RESOLVED] How to get the size of the RTF content from the clipboard ?

$
0
0
How to get the size of the RTF content from the clipboard ?
See below:
Attached Images
 

vbRichClient Cairo - How to get a clipping like this

$
0
0
Name:  QQ??20170422092739.jpg
Views: 83
Size:  11.6 KB

Basically if I have the 4 coordinates marked in blue, the problem will just be solved, but I don't know how. I can't find much useful information in the object viewer...
Attached Images
 

Strange printing problem

$
0
0
None of my VB6 projects (in development mode or exe) are finding my printer, though the printer is working fine with other applications (MS Word, etc.). I'm using a 64 bit desktop with Windows 7. I tried the same projects on a 32 bit XP desktop and on a 64 bit Windows 7 laptop with the same printer and both worked fine. It's only the one computer this is happening with. I have tried restarting it, but no joy.

Any ideas? Reinstall VB6?

Problems with ActiveX exe

$
0
0
Hello guys / girls,

I'm having some problems with using my ActiveX exe server in another project.

It was fine till few days ago.

Compatibility is set and I didn't have any messages that it was broken.

I created an ActiveX server exe and want to use it in my another project. I use it with early binding because I need the events.

Now when I try to use it it gives me the error 430 "class does not support automation or expected interface"

In the client app I have this reference:
Code:

Reference=*\G{BA0FBC84-7332-4E71-BDFB-DE88079C60A5}#1.1#0#VirtualForm2.exe#VirtualForm 2.0
and the .VBR file of the ActiveX exe contains this entries:

Code:

VB5SERVERINFO
VERSION=2.0.9
APPDESCRIPTION=VirtualForm 2.0
HKEY_CLASSES_ROOT\Typelib\{BA0FBC84-7332-4E71-BDFB-DE88079C60A5}\1.1 = VirtualForm 2.0
HKEY_CLASSES_ROOT\Typelib\{BA0FBC84-7332-4E71-BDFB-DE88079C60A5}\1.1\0\win32 = VirtualForm2.exe
HKEY_CLASSES_ROOT\Typelib\{BA0FBC84-7332-4E71-BDFB-DE88079C60A5}\1.1\FLAGS = 0
HKEY_CLASSES_ROOT\VirtualForm2.VFTextBox\CLSID = {2B0EC796-C16E-4EE6-9FAA-4F73E03B1993}
HKEY_CLASSES_ROOT\CLSID\{2B0EC796-C16E-4EE6-9FAA-4F73E03B1993}\ProgID = VirtualForm2.VFTextBox
HKEY_CLASSES_ROOT\CLSID\{2B0EC796-C16E-4EE6-9FAA-4F73E03B1993}\Version = 1.1
HKEY_CLASSES_ROOT\CLSID\{2B0EC796-C16E-4EE6-9FAA-4F73E03B1993}\Typelib = {BA0FBC84-7332-4E71-BDFB-DE88079C60A5}
HKEY_CLASSES_ROOT\CLSID\{2B0EC796-C16E-4EE6-9FAA-4F73E03B1993}\LocalServer32 = VirtualForm2.exe
HKEY_CLASSES_ROOT\INTERFACE\{93F6E4CC-D6AC-424F-9143-4C062512B303} = VFTextBox
HKEY_CLASSES_ROOT\INTERFACE\{93F6E4CC-D6AC-424F-9143-4C062512B303}\ProxyStubClsid = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{93F6E4CC-D6AC-424F-9143-4C062512B303}\ProxyStubClsid32 = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{93F6E4CC-D6AC-424F-9143-4C062512B303}\Typelib = {BA0FBC84-7332-4E71-BDFB-DE88079C60A5}
HKEY_CLASSES_ROOT\INTERFACE\{93F6E4CC-D6AC-424F-9143-4C062512B303}\Typelib\"version" = 1.1
HKEY_CLASSES_ROOT\VirtualForm2.VirtualForm\CLSID = {1D26E07F-8F30-437E-A37C-2E2CA9CBBA47}
HKEY_CLASSES_ROOT\CLSID\{1D26E07F-8F30-437E-A37C-2E2CA9CBBA47}\ProgID = VirtualForm2.VirtualForm
HKEY_CLASSES_ROOT\CLSID\{1D26E07F-8F30-437E-A37C-2E2CA9CBBA47}\Version = 1.1
HKEY_CLASSES_ROOT\CLSID\{1D26E07F-8F30-437E-A37C-2E2CA9CBBA47}\Typelib = {BA0FBC84-7332-4E71-BDFB-DE88079C60A5}
HKEY_CLASSES_ROOT\CLSID\{1D26E07F-8F30-437E-A37C-2E2CA9CBBA47}\LocalServer32 = VirtualForm2.exe
HKEY_CLASSES_ROOT\INTERFACE\{D5393612-8267-49BA-8CE2-789C6444F6D4} = VirtualForm
HKEY_CLASSES_ROOT\INTERFACE\{D5393612-8267-49BA-8CE2-789C6444F6D4}\ProxyStubClsid = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{D5393612-8267-49BA-8CE2-789C6444F6D4}\ProxyStubClsid32 = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{D5393612-8267-49BA-8CE2-789C6444F6D4}\Forward = {54175B73-8259-4D0E-9CE7-2CE4654BCF1C}
HKEY_CLASSES_ROOT\INTERFACE\{54175B73-8259-4D0E-9CE7-2CE4654BCF1C} = VirtualForm
HKEY_CLASSES_ROOT\INTERFACE\{54175B73-8259-4D0E-9CE7-2CE4654BCF1C}\ProxyStubClsid = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{54175B73-8259-4D0E-9CE7-2CE4654BCF1C}\ProxyStubClsid32 = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{54175B73-8259-4D0E-9CE7-2CE4654BCF1C}\Typelib = {BA0FBC84-7332-4E71-BDFB-DE88079C60A5}
HKEY_CLASSES_ROOT\INTERFACE\{54175B73-8259-4D0E-9CE7-2CE4654BCF1C}\Typelib\"version" = 1.1
HKEY_CLASSES_ROOT\INTERFACE\{10051DA6-3B03-4734-8D6D-3B0749290CE8} = VirtualForm
HKEY_CLASSES_ROOT\INTERFACE\{10051DA6-3B03-4734-8D6D-3B0749290CE8}\ProxyStubClsid = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{10051DA6-3B03-4734-8D6D-3B0749290CE8}\ProxyStubClsid32 = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{10051DA6-3B03-4734-8D6D-3B0749290CE8}\Forward = {BC89F75C-9C39-412E-9025-C73C97771047}
HKEY_CLASSES_ROOT\INTERFACE\{BC89F75C-9C39-412E-9025-C73C97771047} = VirtualForm
HKEY_CLASSES_ROOT\INTERFACE\{BC89F75C-9C39-412E-9025-C73C97771047}\ProxyStubClsid = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{BC89F75C-9C39-412E-9025-C73C97771047}\ProxyStubClsid32 = {00020420-0000-0000-C000-000000000046}
HKEY_CLASSES_ROOT\INTERFACE\{BC89F75C-9C39-412E-9025-C73C97771047}\Typelib = {BA0FBC84-7332-4E71-BDFB-DE88079C60A5}
HKEY_CLASSES_ROOT\INTERFACE\{BC89F75C-9C39-412E-9025-C73C97771047}\Typelib\"version" = 1.1

Debugging abilities gone when subclassing with Comctl32.dll

$
0
0
Ok, I'm still trying to make this Comctl32.dll subclassing work the way I'd like.

Everything is going along pretty well ... except, when I subclass and then break (for debugging purposes), I've lost several debugging features. Edwardo and I both hinted at this in another thread, but I'd like to just get more clear on it in this one.

Ok, here it is as simple as I can make it. The following code goes in Module1 (that name is required).

Code:


Option Explicit
'
Private Const WM_DESTROY = &H2&
'
Public Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Public Declare Function GetWindowSubclass Lib "comctl32.dll" Alias "#411" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, pdwRefData As Long) As Long
Public Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Public Declare Function NextSubclassProcOnChain Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'

Public Function Proc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
    If uMsg = WM_DESTROY Then
        RemoveWindowSubclass hWnd, AddressOf Module1.Proc, hWnd
        Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
        Exit Function
    End If

    ' Nothing actually done.

    Proc = NextSubclassProcOnChain(hWnd, uMsg, wParam, lParam)
End Function

And then, a Form1 with two buttons on it (Command1 and Command2), and then this code:

Code:


Option Explicit

Private Sub Form_Load()
    SetWindowSubclass Me.hWnd, AddressOf Proc, Me.hWnd
End Sub

Private Sub Command1_Click()
    Debug.Print "1111"
    Debug.Print "2222"
    Debug.Print "3333"

    Stop

    Debug.Print "7777"
    Debug.Print "8888"
    Debug.Print "9999"
End Sub

Private Sub Command2_Click()
    RemoveWindowSubclass hWnd, AddressOf Module1.Proc, hWnd
End Sub

Now, the form will automatically subclass itself (but the subclassing doesn't even do anything).

Click the Command1 button, thereby hitting the "Stop" statement. We've lost several options on our context menu:

Name:  Context.gif
Views: 25
Size:  16.6 KB

We've also lost all ability to use the IDE's menu:

Name:  Ide.gif
Views: 21
Size:  15.6 KB

Also the debug (immediate) window is inaccessible.
As a further note, the debug keys do still work (F5, F8, shift+F8, ctrl+shift+F9, etc).

Does everyone else have these same problems?
Is it something to do with my particular version of Comctl32.dll?


One last FYI: Once we un-subclass, we get all our functionality back.


Now, in my main project, I've got the following option (when executing in the IDE), but it'd be nice if I could still more easily trace through my code even if I'm subclassing.

Name:  pcode.gif
Views: 28
Size:  7.8 KB

Thanks,
Elroy
Attached Images
   

[RESOLVED] Delete records

$
0
0
Hello vbforums programmers
I need to delete from access database records that have been in database since a value in a combo text but I didn't figure out how to do that.
This is my attempt
Code:

  DB.Execute "Delete FROM Table1 WHERE DateDiff(Y, date_Visit, Now) > Combo1.Text"
I want to delete all the records whose date_visit is greater than the value in the combo Text.
Thank you

Is there a way to make a shortcut to an exe file with vb6?

$
0
0
Hi there folks! I am going to share some of the programs I've been working on with other teachers soon, and I was wondering if there is a line of code that will make a shortcut for the .exe file to the user's desktop.

All of the programs I have been making are just .exe files and some mp3 files. Because of strict computer policies, making an install is out, besides when the teacher doesn't want it anymore, they just can just delete the folder. The programs are simple and I don't think have dependencies on system files.

The teachers laptop will most likely have a 64 bit windows 7, with perhaps a small percentage using windows 10 if that info is important.

Thanks a lot!

VB6 Treeview -Coding selective expansion of nodes

$
0
0
I'm new to using Treeview so please excuse my ignorance for asking this question.

Say I have a Treeview like this...

Food
+--Beverages
----------Water
----------Soda Pop
+--Fruits
----------Apples
----------Oranges
----------Peaches
+--Meats
----------Beef
----------Chicken

How do I code it so when I click on Food it just shows Beverages, Fruits, and Meats but not the Water, Soda Pop, Apples, and other sub-items?

Also, I need to be able to select an item from code, for example,
TreeView1.SelectedItem = TreeView1.Nodes.Item("Food, Fruits, Apples") but have the Treeview expand just that particular branch, without expanding all the other Food branches to show Water, Beef, and etc.

I've seen examples elsewhere using recursive loops with MSComctlLib.Node but don't know how to apply that to my application. Any help is appreciated.

Is there a better way to replace Subclass?

$
0
0
Subclass is a restricted area for many VB programmers. Is there a better way to replace Subclass?

Does QT use Subclass? Does vbRichClient use Subclass?

POS Receipt Printing in VB6

$
0
0
Hi there I am struggling to print a POS receipt in VB6
I have a listview where the receipt is displayed as the transaction unfolds I need it to be sent to the POS printer as the transaction is commencing.

So basically the receipt must be printed in stages as the transaction is started the shop info must be printed "remember it is also displayed in the listview" then the sale information the goods Code Description and Qty and price as the user scans the barcodes the line is displayed in the listview and then printed on the printer at the end when the user indicate the total and type in the amount the client gives him just after the money is handen and typed in the POS cash drawer must be kicked open thrue the printer and the change with the good buy msg will be the last line to be printed!
Can some one please help me I have looked everywhere and found only junk code!

I am an amateur trying to learn!

Color saves differently?

$
0
0
When I save the background color of a textbox to a file, the code that saves is different.

For example; A TextBox has this color = &H89E295. If I save it to a file, using WriteData(1).Clr = Text1.BackColor, it saves as 9036437.

In some cases, when I open the file, it will open as the same color. But not all colors open as original.

Ideas??

Delete from two tables in one query

$
0
0
Hello everyone
I need to delete records in two tables.
This is my code but it only deletes from the child table.
Code:

sSQL = "Select date_visit FROM Table1 inner join Table2 on Table1 .Id = Table2 .PID WHERE DateDiff('yyyy', date_visit, now) > " & Combo1.Text
RS.Open sSQL, DB, adOpenStatic, adLockOptimistic
RS.MoveFirst
While Not RS.EOF
RS.Delete
RS.MoveNext
Wend
Set RS = Nothing
End Sub

thank you

[RESOLVED] VB6 Treeview -Coding selective expansion of nodes

$
0
0
I'm new to using Treeview so please excuse my ignorance for asking this question.

Say I have a Treeview like this...

Food
+--Beverages
----------Water
----------Soda Pop
+--Fruits
----------Apples
----------Oranges
----------Peaches
+--Meats
----------Beef
----------Chicken

How do I code it so when I click on Food it just shows Beverages, Fruits, and Meats but not the Water, Soda Pop, Apples, and other sub-items?

Also, I need to be able to select an item from code, for example,
TreeView1.SelectedItem = TreeView1.Nodes.Item("Food, Fruits, Apples") but have the Treeview expand just that particular branch, without expanding all the other Food branches to show Water, Beef, and etc.

I've seen examples elsewhere using recursive loops with MSComctlLib.Node but don't know how to apply that to my application. Any help is appreciated.

[RESOLVED] Delete from two tables in one query

$
0
0
Hello everyone
I need to delete records in two tables.
This is my code but it only deletes from the child table.
Code:

sSQL = "Select date_visit FROM Table1 inner join Table2 on Table1 .Id = Table2 .PID WHERE DateDiff('yyyy', date_visit, now) > " & Combo1.Text
RS.Open sSQL, DB, adOpenStatic, adLockOptimistic
RS.MoveFirst
While Not RS.EOF
RS.Delete
RS.MoveNext
Wend
Set RS = Nothing
End Sub

thank you

301 Move Permanent

$
0
0
Hi, I have been succesfull accessing a site Http://ich.... , now the site start using ssl Https:// and I get a 301 Moved Permanent, and show Location https://ich....., can someone please help me fix the code, thanks
in advance. Tony

------------------------------------------------------------
Function URLstripHttP(ByVal tUrl$) As String
tUrl$ = Trim(tUrl$)
If Left$(LCase(tUrl$), 7) = "http://" Then
URLstripHttP$ = Right$(tUrl$, Len(tUrl$) - 7)
Else: URLstripHttP$ = tUrl$
End If
End Function
----------------------------------------------------------------------
Function URLHost(ByVal tUrl$) As String
tUrl$ = Trim(tUrl$)
tUrl$ = URLstripHttP(tUrl$)
pos = InStr(tUrl$, "/")
If pos = 0 Then
URLHost$ = tUrl$
Else
URLHost$ = Left(tUrl$, pos - 1)
End If
End Function
------------------------------------------------------------------------
Function URLDocument(ByVal tUrl$) As String
tUrl$ = Trim(tUrl$)
tUrl$ = URLstripHttP(tUrl$)
For A = 1 To Len(tUrl$)
If Mid$(tUrl$, A, 1) = "/" Then
URLDocument = Right$(tUrl$, Len(tUrl$) - A)
Exit Function
End If
Next
URLDocument = "": Exit Function 'Not Found
End Function
------------------------------------------------------------------
Function UrlMsg$(ByVal tUrl$) ' pretend to be a browser
tDocument$ = URLDocument(tUrl$)
Dim tHost$

Msg$ = ""
Msg$ = Msg$ + "GET /" & tDocument$ & " HTTP/1.1" & vbCrLf
Msg$ = Msg$ & "Host:" & URLHost(tUrl$) & vbCrLf 'NEW LINE ADDED
Msg$ = Msg$ + "Accept: */*" & vbCrLf
Msg$ = Msg$ + "Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8" & vbCrLf
Msg$ = Msg$ + "User-Agent: Mozilla/5.0 (Windows NT 6.1; rv:12.0) Gecko/20100101 Firefox/12.0" & vbCrLf
Msg$ = Msg$ + "Accept-Language: en-us,en;q=0.5" & vbCrLf
Msg$ = Msg$ + "Connection: Close" & vbCrLf


Msg$ = Msg$ & vbCrLf
UrlMsg$ = Msg$
End Function
---------------------------------------------------------------------
Viewing all 21634 articles
Browse latest View live


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>