Results 1 to 6 of 6

Thread: [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Apr 2021
    Posts
    166

    [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

    Hello everyone I would like to share my distribution of this program in vb6 that you helped me to make open source a mini windows 1.0 gui functional but I ask you to read infor.txt thanks to everyone who contributed this is very interesting and can also be reproduced in vb 1.0 for msdos for those interested in dynamic file browsing.

    thanks to all contributors.


    https://www.mediafire.com/file/08uda...ICVBP.zip/file
    Last edited by Shaggy Hiker; May 1st, 2021 at 10:59 AM.

  2. #2
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,807

    Re: [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

    Your program doesn't start. It just freezes.

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Apr 2021
    Posts
    166

    Re: [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

    Quote Originally Posted by Peter Swinkels View Post
    Your program doesn't start. It just freezes.
    Run: winsimulator1.0 (winsim1.0) if it is ok then if you don't open the vbp file edit the project and change the following:

    NameFile = Dir $ (SubDir, vbDirectory)

    By: NameFile = Dir $ (SubDir)

    then do the following.

    Do While NameFile <> vbNewstring
    List1.AddItem NameFile
    NameFile = Dir $, vbdirectory
    Loop
    Text1.Text = "c: "
    End Sub

    Or add your own suggestion that you helped me friend, which also worked but this one froze here:

    NameFile = Dir $ ("*. *", VbDirectory)

  4. #4
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,807

    Re: [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

    Nice, but:

    1. Please use code tags. (The "#" button above a message to be submitted to this forum.
    2. Add "Option Explicit" at the top of your module level declarations. In fact turn it on by default. Go to the "Tools" menu, select "Options" and check "Require variable declaration."
    3. "vbNewString" should be "vbNullString".
    4. Windows 1.0 never supported long file names. To make it more authentic use short file names. https://docs.microsoft.com/en-us/win...shortpathnamew.
    5. "Form1", "Project1", "Text1", "List1", ect are default object names. You should give them a descriptive name. Escpecially in larger projects.
    6. "Do While NameFile <> vbNewstring" could be rewritten as "Do Until NameFile = vbNewstring".

    Here's an example on how to use the ANSi (GetShortPathNameA) version of the API function I linked to:
    Code:
    'This module contains an example of how to retrieve 8.3 versions of long file names.
    Option Explicit
    
    Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000      'Indicates that a system error message should be retrieved.
    Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200&   'Indicates that no extra information is inserted into the error message.
    Private Const MAX_PATH  As Long = 260                          'Defines the maximum length for a path.
    Private Const MAX_STRING As Long = 65535                       'Defines the maximum length for a string.
    
    'The Microsoft Windows API functions used.
    Private Declare Function FormatMessageA Lib "Kernel32.dll" (ByVal dwFlags As Long, lpSource As Long, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long
    Private Declare Function GetShortPathNameA Lib "Kernel32.dll" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, cchBuffer As Long) As Long
    
    'This procedure returns the appropriate error message for the specified error code.
    Private Function GetErrorMessage(ErrorCode As Long) As String
    Dim Length As Long
    Dim Message As String
          
       Message = String$(MAX_STRING, vbNullChar)
       Length = FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, CLng(0), ErrorCode, CLng(0), Message, Len(Message), CLng(0))
       If Length = 0 Then
          Message = "No description."
       ElseIf Length > 0 Then
          Message = Left$(Message, Length - 1)
       End If
       
       GetErrorMessage = Message
    End Function
    'This procedure returns the 8.3 name for the specified long file name.
    Private Function GetShortName(LongName As String) As String
    Dim ErrorCode As Long
    Dim ShortLength As Long
    Dim ShortName As String
    
       ShortName = String$(MAX_PATH, vbNullChar)
       ShortLength = GetShortPathNameA(LongName, ShortName, Len(ShortName))
       ErrorCode = Err.LastDllError
       If ShortLength = 0 Then
          ShortName = vbNullString
          MsgBox "Error code " & CStr(ErrorCode) & ":" & vbCr & GetErrorMessage(ErrorCode), vbOKOnly Or vbExclamation, App.Title
       Else
          ShortName = Left$(ShortName, ShortLength)
       End If
    
       GetShortName = ShortName
    End Function
    
    'This procedure is executed when this program is started.
    Public Sub Main()
    Dim ShortName As String
    
    ShortName = GetShortName("C:\Program Filaes\")
    If Not ShortName = vbNullString Then MsgBox ShortName, vbInformation
    End Sub
    It also demonstrates how to handle errors that occur during API calls. They're not caught by default as with other errors.

    Peter
    Last edited by Peter Swinkels; May 1st, 2021 at 04:08 PM.

  5. #5

    Thread Starter
    Addicted Member
    Join Date
    Apr 2021
    Posts
    166

    Re: [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

    Nice imrpovement guy this fantastic. Thanks by your contribuition for this windows version simulator.

  6. #6
    Frenzied Member
    Join Date
    Feb 2003
    Posts
    1,807

    Re: [VB6] Windows 1.0 Project OPEN SOURCE NOSTALGIC

    Glad to be of help.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width