فراخوانی Crystal Report از درون برنامه

[j.farazani]

سلام خدمت همه دوستان عزيزم

قبلا يه تاپيك با موضوع مشابه اين تاپيك ايجاد شده بود اما هر چي مي گردم پيداش نمي كنم اگه دوستان لينك اين تاپيك رو دارن يا اينكه كد مربوطه رو در اختيار بگذارند ممنون مي شم

[HjSoft]

منكه اين تاپيك رو نديدم ، بهتره بگين مشكل تون چي بود تا كمكتون كنيم . ؟
موفق باشيد /./

[saeedzx]

منظور شما اینکه مثلاً ماشین حساب رو اجرا کنید ویا Not pad
و یا اینکه یک فایل exe رو از تو برنامه اجرا کنید

[j.farazani]

سلام

ببینید می خوام کاربر از درون برنامه یک گزارش کریستال ریپورت رو باز کنه اما این گزارش باید در محیط کریستال ریپورت باز بشه دیگه !!!

یعنی وقتی که کاربر زوی فایل گزارش مورد نظر کلیک کرد نرم افزار کریستال 9 باز بشه و گزارش مربوطه در اون نمایش داده بشه


ممنون

[Babak.Hassanpour]

در ماژول



Option Explicit

Private Const REG_NONE As Long = 0
Private Const REG_SZ As Long = 1
Private Const REG_EXPAND_SZ As Long = 2
Private Const REG_BINARY As Long = 3
Private Const REG_DWORD As Long = 4
Private Const ERROR_SUCCESS As Long = 0
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_NO_MORE_ITEMS As Long = 259
Private Const HKEY_CLASSES_ROOT As Long = &H80000000

Private Declare Function RegOpenKey Lib "advapi32.dll" _
Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As _
String, phkResult As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long

Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long



در فرم


Public Function OpenFile(ByVal pFileName As String) As Boolean

' Open the specified file with its associated application
' Return True if the file was open successfully
' False if its extension is not registered
'

'Example: OpenFile "C:\MyDocuments\MyDoc.doc"
Dim lExtension As String
Dim lType As String, lCommandLine As String
Dim i As Integer

OpenFile = False

' We identify the file extension
lExtension = "." + GetFileExtension(pFileName)

If Len(lExtension) > 1 Then

' If pFileName contains at least one space, it's a long filename,
' we add " characters
If InStr(1, pFileName, " ") <> 0 Then
pFileName = """" + pFileName + """"
End If

' Get the corresponding file type in the registry
lType = regQuery_A_Key(HKEY_CLASSES_ROOT, lExtension, "")
If lType = "" Then
' Unknown type
Exit Function
End If

' Get the corresponding command line
lCommandLine = regQuery_A_Key(HKEY_CLASSES_ROOT, _
lType + "\shell\open\command", "")

If lCommandLine = "" Then
' No application can open this file type
Exit Function
End If

' Replace %1 with pFileName in lCommandLine
If Not StringReplace(lCommandLine, "%1", _
pFileName) Then
' Add the file name at the end of the command line
lCommandLine = lCommandLine + " " + pFileName
End If

' Execute this command line
Call Shell(lCommandLine, vbMaximizedFocus)

OpenFile = True

End If

End Function


Public Function StringReplace(pString1 As String, _
pString2 As String, pString3 As String) As Boolean

'Replace all the occurences of pString2 in pString1 by pString3

Dim i As Integer
Dim lString As String

StringReplace = False

lString = pString1
i = InStr(1, lString, pString2)
While i <> 0
StringReplace = True
If i + Len(pString2) <= Len(lString) Then
lString = Left(lString, i - 1) + pString3 + _
Right(lString, Len(lString) - i - Len(pString2) + 1)
Else
lString = Left(lString, i - 1) + pString3
End If

i = InStr(1, lString, pString2)
Wend

pString1 = lString

End Function


Public Function regQuery_A_Key(ByVal hKey As Long, _
ByVal sRegKeyPath As String, _
ByVal sRegSubKey As String) As Variant

' --------------------------------------------------------------
' Written by Kenneth Ives kenaso@home.com
'
' Important: If you treat all key data strings as being
' case sensitive, you should never have a problem.
' Always backup your registry files (System.dat
' and User.dat) before performing any type of
' modifications
'
' Description: Function for querying a sub key value.
'
' Parameters:
' hKey - HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
' HKEY_lOCAL_MACHINE, HKEY_USERS, etc
' sRegKeyPath - is name of the key path you wish to traverse.
' sRegSubKey - is the name of the key which will be queryed.
'
' Syntax:
' sKeyQuery = regQuery_A_Key(HKEY_CURRENT_USER, _
' "Software\AAA-Registry Test\Products", _
"StringTestData")
'
' Returns the key value of "StringTestData"
' --------------------------------------------------------------

' --------------------------------------------------------------
' Define variables
' --------------------------------------------------------------
Dim iPos As Integer
Dim lKeyHandle As Long
Dim lRet As Long
Dim lDataType As Long
Dim lBufferSize As Long
Dim lBuffer As Long
Dim sBuffer As String
Dim arBuffer() As Byte

' --------------------------------------------------------------
' Initialize variables
' --------------------------------------------------------------
lKeyHandle = 0
lBufferSize = 0

' --------------------------------------------------------------
' Query the key path
' --------------------------------------------------------------
lRet = RegOpenKey(hKey, sRegKeyPath, lKeyHandle)

' --------------------------------------------------------------
' If no key handle was found then there is no key. Leave here.
' --------------------------------------------------------------
If lKeyHandle = 0 Then
regQuery_A_Key = ""
lRet = RegCloseKey(lKeyHandle) ' always close the handle
Exit Function
End If

' --------------------------------------------------------------
' Query the registry and determine the data type.
' --------------------------------------------------------------
lRet = RegQueryValueEx(lKeyHandle, sRegSubKey, 0&, _
lDataType, ByVal 0&, lBufferSize)

' --------------------------------------------------------------
' If no key handle was found then there is no key. Leave.
' --------------------------------------------------------------
If lKeyHandle = 0 Then
regQuery_A_Key = ""
lRet = RegCloseKey(lKeyHandle) ' always close the handle
Exit Function
End If

' --------------------------------------------------------------
' Make the API call to query the registry based on the type
' of data.
' --------------------------------------------------------------
Select Case lDataType
Case REG_SZ: ' String data (most common)
' Preload the receiving buffer area
sBuffer = Space(lBufferSize)

lRet = RegQueryValueEx(lKeyHandle, sRegSubKey, 0&, 0&, _
ByVal sBuffer, lBufferSize)

' If NOT a successful call then leave
If lRet <> ERROR_SUCCESS Then
regQuery_A_Key = ""
Else
' Strip out the string data
iPos = InStr(1, sBuffer, Chr(0))
' look for the first null char

If iPos > 0 Then
' if we found one, then save everything
'up to that point

regQuery_A_Key = Left(sBuffer, iPos - 1)
Else
' did not find one. Save everything.
regQuery_A_Key = sBuffer
End If
End If

Case REG_DWORD: ' Numeric data (Integer)
lRet = RegQueryValueEx(lKeyHandle, sRegSubKey, _
0&, lDataType, lBuffer, 4&)
' 4& = 4-byte word (long integer)

' If NOT a successful call then leave
If lRet <> ERROR_SUCCESS Then
regQuery_A_Key = ""
Else
' Save the captured data
regQuery_A_Key = lBuffer
End If

Case Else: ' unknown
regQuery_A_Key = ""
End Select

' --------------------------------------------------------------
' Always close the handle in the registry. We do not want to
' corrupt these files.
' --------------------------------------------------------------
lRet = RegCloseKey(lKeyHandle)

End Function

Private Function GetFileExtension(pFileName As String) As String

Dim i As Integer

i = Len(pFileName)
While Mid(pFileName, i, 1) <> "."
i = i - 1
If i = 0 Then
' No extension
Exit Function
End If
Wend

GetFileExtension = Right(pFileName, Len(pFileName) - i)

End Function