Bosna i Hercegovina



#1 24.03.2012-11:59
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Windows7 zaštita(Stara Nova Tema)
Imam ovaj kod koji ne radi na Windows7:
DownloadIzvorni kod (Text):
  1. Option Explicit
  2. Option Compare Database
  3.  
  4. Private 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
  5. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  6. Private Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
  7.  
  8. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  9.  
  10. Private Const GENERIC_READ = &H80000000
  11. Private Const GENERIC_WRITE = &H40000000
  12. Private Const FILE_SHARE_READ = &H1
  13. Private Const FILE_SHARE_WRITE = &H2
  14. Private Const OPEN_EXISTING = 3
  15. Private Const INVALID_HANDLE_VALUE = -1&
  16.  
  17. Public Const DFP_GET_VERSION = &H74080
  18. Public Const DFP_SEND_DRIVE_COMMAND = &H7C084
  19. Public Const DFP_RECEIVE_DRIVE_DATA = &H7C088
  20.  
  21. Public Const IDE_ATAPI_IDENTIFY = &HA1
  22. Public Const IDE_ATA_IDENTIFY = &HEC
  23.  
  24. Public Const IDENTIFY_BUFFER_SIZE = 512
  25.  
  26. Public Type GETVERSIONOUTPARAMS
  27.    bVersion As Byte      ' Binary driver version.
  28.    bRevision As Byte     ' Binary driver revision.
  29.    bReserved As Byte     ' Not used.
  30.    bIDEDeviceMap As Byte ' Bit map of IDE devices.
  31.    fCapabilities As Long ' Bit mask of driver capabilities.
  32.    dwReserved1 As Long   ' For future use.
  33.    dwReserved2 As Long   ' For future use.
  34.    dwReserved3 As Long   ' For future use.
  35.    dwReserved4 As Long   ' For future use.
  36. End Type
  37.  
  38. Public Type IDEREGS
  39.    bFeaturesReg As Byte       ' Used for specifying SMART "commands".
  40.    bSectorCountReg As Byte    ' IDE sector count register
  41.    bSectorNumberReg As Byte   ' IDE sector number register
  42.    bCylLowReg As Byte         ' IDE low order cylinder value
  43.    bCylHighReg As Byte        ' IDE high order cylinder value
  44.    bDriveHeadReg As Byte      ' IDE drive/head register
  45.    bCommandReg As Byte        ' Actual IDE command.
  46.    bReserved As Byte          ' reserved for future use.  Must be zero.
  47. End Type
  48.  
  49. Public Type SENDCMDINPARAMS
  50.    cBufferSize As Long      '  Buffer size in bytes
  51.    irDriveRegs As IDEREGS   '  Structure with drive register values.
  52.    bDriveNumber As Byte     '  Physical drive number to send command to (0,1,2,3).
  53.    bReserved1 As Byte       '  Reserved for future expansion.
  54.    bReserved2 As Byte       '  Reserved for future expansion.
  55.    bReserved3 As Byte       '  Reserved for future expansion.
  56.    dwReserved1 As Long      '  For future use.
  57.    dwReserved2 As Long      '  For future use.
  58.    dwReserved3 As Long      '  For future use.
  59.    dwReserved4 As Long      '  For future use.
  60.    bBuffer() As Byte        '  Input buffer.
  61. End Type
  62.  
  63. Public Type DRIVERSTATUS
  64.    bDriverError As Byte  '  Error code from driver, or 0 if no error.
  65.    bIDEStatus As Byte    '  Contents of IDE Error register, only valid when bDriverError is SMART_IDE_ERROR.
  66.    bReserved1 As Byte    '  Reserved for future expansion.
  67.    bReserved2 As Byte    '  Reserved for future expansion.
  68.    dwReserved1 As Long   '  Reserved for future expansion.
  69.    dwReserved2 As Long   '  Reserved for future expansion.
  70. End Type
  71.  
  72. Public Type SENDCMDOUTPARAMS
  73.    cBufferSize As Long            ' Size of bBuffer in bytes
  74.    inDriveStatus As DRIVERSTATUS  '  Driver status structure.
  75.    bBuffer() As Byte              '  Buffer of arbitrary length in which to store the data read from the                                                       // drive.
  76. End Type
  77.  
  78. Public Enum vbDiskDataType
  79.     vbDriveModelNumber = 0
  80.     vbDriveSerialNumber = 1
  81.     vbDriveControllerRevisionNumber = 2
  82.     vbControllerBufferSize = 3
  83.     vbDriveType = 4
  84. End Enum
  85.  
  86. Function ConvertToString(DiskData() As Byte, firstIndex As Long, lastIndex As Long) As String
  87.     Dim Index As Integer
  88.     Dim s As String
  89.     Index = firstIndex
  90.     While Index <= lastIndex
  91.         s = s + Chr(DiskData(Index + 1)) + Chr(DiskData(Index))
  92.         Index = Index + 2
  93.     Wend
  94.     ConvertToString = Trim(s)
  95. End Function
  96.  
  97. Function GetDiskData(DataType As vbDiskDataType) As String
  98.     GetDiskData = ""
  99.     Dim hPhysicalDriveIOCTL As Long
  100.     hPhysicalDriveIOCTL = CreateFile("\\.\PhysicalDrive0", _
  101.                             GENERIC_READ Or GENERIC_WRITE, _
  102.                             FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, _
  103.                             OPEN_EXISTING, 0, 0)
  104.     If hPhysicalDriveIOCTL <> INVALID_HANDLE_VALUE Then
  105.         Dim VersionParams As GETVERSIONOUTPARAMS
  106.         Dim cbBytesReturned  As Long
  107.         If DeviceIoControl(hPhysicalDriveIOCTL, DFP_GET_VERSION, _
  108.             Null, 0, VersionParams, Len(VersionParams), cbBytesReturned, 0) <> 0 Then
  109.    
  110.             If VersionParams.bIDEDeviceMap > 0 Then
  111.                
  112.                 Dim cmd_in As SENDCMDINPARAMS
  113.                 Dim cmd_out As SENDCMDOUTPARAMS
  114.                 Dim buf(Len(cmd_out) + IDENTIFY_BUFFER_SIZE - 1) As Byte
  115.                 Dim bIDCmd As Byte
  116.                 If (VersionParams.bIDEDeviceMap And &H10) = &H10 Then
  117.                     bIDCmd = IDE_ATAPI_IDENTIFY
  118.                 Else
  119.                     bIDCmd = IDE_ATA_IDENTIFY
  120.                 End If
  121.  
  122.                 cmd_in.cBufferSize = IDENTIFY_BUFFER_SIZE
  123.                 cmd_in.irDriveRegs.bFeaturesReg = 0
  124.                 cmd_in.irDriveRegs.bSectorCountReg = 1
  125.                 cmd_in.irDriveRegs.bSectorNumberReg = 1
  126.                 cmd_in.irDriveRegs.bCylLowReg = 0
  127.                 cmd_in.irDriveRegs.bCylHighReg = 0
  128.                 cmd_in.irDriveRegs.bDriveHeadReg = &HA0 ' 0xA0 | ((bDriveNum & 1) << 4);
  129.  
  130.                 cmd_in.irDriveRegs.bCommandReg = bIDCmd
  131.                 cmd_in.bDriveNumber = 0  ' bDriveNum
  132.                 cmd_in.cBufferSize = IDENTIFY_BUFFER_SIZE
  133.                 cbBytesReturned = 0
  134.                 If DeviceIoControl(hPhysicalDriveIOCTL, DFP_RECEIVE_DRIVE_DATA, _
  135.                         cmd_in, Len(cmd_in) - 1, buf(0), _
  136.                         Len(cmd_out) + IDENTIFY_BUFFER_SIZE - 1, _
  137.                         cbBytesReturned, 0) <> 0 Then
  138.                    
  139.                     If DataType = vbDriveModelNumber Then GetDiskData = ConvertToString(buf, 70, 108)
  140.                     If DataType = vbDriveSerialNumber Then GetDiskData = ConvertToString(buf, 36, 54)
  141.                     If DataType = vbDriveControllerRevisionNumber Then GetDiskData = ConvertToString(buf, 62, 68)
  142.                     If DataType = vbControllerBufferSize Then GetDiskData = Str((CLng(buf(58)) + CLng(buf(59)) * 256) * 512)
  143.                     If DataType = vbDriveType Then
  144.                         If (buf(16) And &H80) = &H80 Then
  145.                             GetDiskData = "Removable"
  146.                         ElseIf (buf(16) And &H40 = &H40) Then
  147.                             GetDiskData = "Fixed"
  148.                         Else
  149.                             GetDiskData = "Unknown"
  150.                         End If
  151.                     End If
  152.                 End If
  153.             End If
  154.         End If
  155.         CloseHandle hPhysicalDriveIOCTL
  156.     End If
  157. End Function
Prije sam imao odgovor da trebam uraditi ovo:
Citat:
moraš
"Private Declare Function CreateFile " promjeniti u Private Declare PtrSafe Function CreateFile
i tako za sve Declare Function u Declare PtrSafe Function ali s tim umetkom (PtrSafe ) radi i na XP pa možeš s replace . Neznam koju grešku ti javlja al mei je javljao nešto tipa =[Fild] bla bla al sam zaboravio i drugo ako ti fali neka referenca moraš je (ako instliraš kroz .BAT) pokrenuti kroz desni click i install as admin jer se inače ne instalira
Ali kad ovo ubacim u kod javlj odmah grešku u funkciji.Zna li neko rješenje da li treba za ovaj PtrSafe dodati još neku referencu ili je nešto drugo.
Miro
↑  ↓

#2 24.03.2012-13:06
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Private Declare PtrSafe 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
Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare PtrSafe Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, ByRef lpInBuffer As Any, ByVal nInBufferSize As Long, ByRef lpOutBuffer As Any, ByVal nOutBufferSize As Long, ByRef lpBytesReturned As Long, ByVal lpOverlapped As Long) As Long
↑  ↓

#3 26.03.2012-13:46
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Evo sad sam to probao ali mi javlja ovu grešku.Znači ne prihvata da se to ubaci u VB

Ikona prilozene slike:
Greska.png
Tip fajla: Informacije o fajlu: png png
Preuzimanja: 38
Veličina: 167.26 KB
Veličina slike: 605 x 454 Pixels


Miro
↑  ↓

#4 27.03.2012-15:58
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Ja radim na 2010 pa su komponente drukčije
Evo ti sve detaljno

http://msdn.microsoft.com/...91831.aspx
↑  ↓

#5 27.03.2012-16:01
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


Subject: Re: Windows7 zaštita(Stara Nova Tema)
' A user-defined type to store the window dimensions.
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Test which version of VBA you are using.
#If VBA7 Then
' API function to locate a window.
Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As LongPtr

' API function to retrieve a window's dimensions.
Declare PtrSafe Function GetWindowRect Lib "user32" ( _
ByVal hwnd As LongPtr, _
lpRect As RECT) As Long

#Else
' API function to locate a window.
Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

' API function to retrieve a window's dimensions.
Declare Function GetWindowRect Lib "user32" ( _
ByVal hwnd As Long, _
lpRect As RECT) As Long
#End If

Sub DisplayExcelWindowSize()
Dim hwnd As Long, uRect As RECT

' Get the handle identifier of the main Excel window.
hwnd = FindWindow("XLMAIN", Application.Caption)

' Get the window's dimensions into the RECT UDT.
GetWindowRect hwnd, uRect

' Display the result.
MsgBox "The Excel window has these dimensions:" & _
vbCrLf & " Left: " & uRect.Left & _
vbCrLf & " Right: " & uRect.Right & _
vbCrLf & " Top: " & uRect.Top & _
vbCrLf & " Bottom: " & uRect.Bottom & _
vbCrLf & " Width: " & (uRect.Right - uRect.Left) & _
vbCrLf & " Height: " & (uRect.Bottom - uRect.Top)

End Sub
↑  ↓

#6 28.03.2012-07:09
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Da to je ta access 2010.Isto tako ovo "PtrSafe" radi samo u vb7.A Access 2003 ima vb6.Ništa probat ću malo guglat pa da vidim.
Miro
↑  ↓

#7 29.03.2012-06:35
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


Subject: Re: Windows7 zaštita(Stara Nova Tema)
jest - - ne radi na access 2003
možda da si skineš access 2010 pa si iskompeliraš program i dodaš par novotarija koje on pruža ?
↑  ↓

#8 29.03.2012-07:00
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Planiram prelazit na 2010.Još nešto sam našao npr ovaj code:
DownloadIzvorni kod (Text):
  1. #If VBA7 Then
  2. Private Declare PtrSafe 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
  3. #Else
  4. Private 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
  5. #End If

Miro
↑  ↓

#9 29.03.2012-07:08
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Fora je kod 2010 što kroz XML možeš editirati office ribbon

Ikona prilozene slike:
ogi.JPG
Tip fajla: Informacije o fajlu: jpg jpg
Preuzimanja: 45
Veličina: 63.26 KB
Veličina slike: 1375 x 368 Pixels

↑  ↓

#10 29.03.2012-13:22
miro35 Offline
Moderator
Registrovan/a od: 05.01.2009-15:56
Komentari: 609


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Zanima me da li će moje meni-je i tolbare pretvoriti u ribon kad pretvorim iz 2003 u 2010
Miro
↑  ↓

#11 30.03.2012-06:54
roko Offline
Clan
Registrovan/a od: 02.02.2009-00:23
Komentari: 236


Subject: Re: Windows7 zaštita(Stara Nova Tema)
Ako je ad-in oče ali ako očeš baš velike ikone i onakav izgled to češ morati napisati .
Pokrenuo sam temu al me niko nije baš doživio.

http://www.icentar.ba/...&q=ribbon
↑  ↓

Stranice (1): 1


All times are GMT +01:00. Current time: 14.12.2017-01:34.