Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

OPen file in the same application

Status
Not open for further replies.

Robertge

Programmer
Jul 4, 2002
18
IT
Hi

I'm creating a TXT/RTF editor (MDI .exe) in VB 6

I have associated TXT and RTF file to be opend (with doulcle click) with my editor program

Now I would like to open multiple file with the same instance of the application (for example if I double click on more txt file) or use the same application (already opened) when I double-click on another txt file of RTF

I tried with DDE but I 'm not able to let it work

Thanks for who will help me and best wishes
 
Thanks a lot Hypatia

In the while I found also this method (with MailSlot) as follows

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Declare Function CreateMailslotNoSecurity Lib "kernel32" Alias "CreateMailslotA" (ByVal lpName As String, ByVal nMaxMessageSize As Long, ByVal lReadTimeout As Long, ByVal Zero As Long) As Long
Declare Function GetMailslotInfo Lib "kernel32" (ByVal hMailslot As Long, lpMaxMessageSize As Long, lpNextSize As Long, lpMessageCount As Long, lpReadTimeout As Long) As Long
Declare Function SetMailslotInfo Lib "kernel32" (ByVal hMailslot As Long, ByVal lReadTimeout As Long) As Long
Declare Function ReadFileSimple Lib "kernel32" Alias "ReadFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal Zero As Long) As Long
Declare Function WriteFileSimple Lib "kernel32" Alias "WriteFile" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal Zero As Long) As Long
Declare Function CreateFileNoSecurity Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal Zero As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, _
ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, _
lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long

Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, _
lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _
lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long

Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _
(ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes _
As Long, ByVal hTemplateFile As Long) As Long

Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _
(ByVal lpBuffer As String, nSize As Long) As Long

Public Declare Function CreateMailslot Lib "kernel32" Alias "CreateMailslotA" _
(ByVal lpName As String, ByVal nMaxMessageSize As Long, _
ByVal lReadTimeout As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long

Public Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type

Public Const OPEN_EXISTING = 3
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Public Const GENERIC_EXECUTE = &H20000000
Public Const GENERIC_ALL = &H10000000
Public Const INVALID_HANDLE_VALUE = -1
Public Const FILE_SHARE_READ = &H1
Public Const FILE_SHARE_WRITE = &H2
Public Const FILE_ATTRIBUTE_NORMAL = &H80

Public Const MAILSLOT_WAIT_FOREVER = -1

Global mshandle As Long
Global Const mailslotname = "\\.\mailslot\messngr"
Global Const BufferSize = 255

Sub Main()
OpenMailSlot
ReadMailSlot
CloseMailSlot
End
End Sub

Sub OpenMailSlot()
Dim sec As SECURITY_ATTRIBUTES

With sec
.bInheritHandle = False
.lpSecurityDescriptor = 0
.nLength = Len(sec)
End With

mshandle = CreateMailslot(mailslotname, 0, 0, sec)
If mshandle = INVALID_HANDLE_VALUE Then
MsgBox "Error: cannot open mailslot.", vbCritical
End
End If

End Sub

Sub CloseMailSlot()
Dim rc As Long

rc = CloseHandle(mshandle)

End Sub

Sub ReadMailSlot()
Dim rc As Long
Dim msgtxt As String
Dim bytesread As Long
Dim msgno As Long
Dim frmtxt As String, totxt As String, msg As String, m As Integer, n As Integer

msgtxt = String(BufferSize, 0)
Do While True
rc = GetMailslotInfo(mshandle, 0, BufferSize, msgno, 0)
Do While msgno > 0
rc = ReadFileSimple(mshandle, msgtxt, Len(msgtxt) + 1, bytesread, 0)
m = 1
n = InStr(m, msgtxt, Chr(0))
If n > 0 Then
frmtxt = Mid(msgtxt, m, n - 1)
m = n + 1
End If
n = InStr(m, msgtxt, Chr(0))
If n > 0 Then
totxt = Mid(msgtxt, m, n - m)
m = n + 1
End If
n = InStr(m, msgtxt, Chr(0))
If n > 0 Then
msg = Mid(msgtxt, m, n - m)
End If
MsgBox "From: " & frmtxt & Chr(13) & Chr(10) & _
"To: " & totxt & Chr(13) & Chr(10) & _
"--------------" & Chr(13) & Chr(10) & _
msg, vbInformation + vbSystemModal

rc = GetMailslotInfo(mshandle, 0, BufferSize, msgno, 0)
Loop
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Sleep 1000
DoEvents
Loop

End Sub


 
Sorry

last code was only a sample, not really related to the question: It must be personalized

regards
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top