Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Problem z funkcją...
anonim




Typ: Nie zarejestrowany
Problem z funkcją...

Problem dotyczy funkcji Api....funkcja ta dziala na systemie 98 lecz nie dziala na xp.A o to zrodlo.

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Function dyski(Optional cdromek As Boolean = False)
Dim Disques As String
Dim RetVal As Long
Dim TypDrive As Long
Dim twardy As Boolean
Disques = String$(128, Chr$(0))
RetVal = GetLogicalDriveStrings(128, Disques)
Disques = Left$(Disques, RetVal)
p% = InStr(Disques, Chr$(0))
While p% <> 0
    d1$ = Left$(Disques, p% - 1)
    Disques = Right$(Disques, Len(Disques) - p%)
    TypDrive = GetDriveType(d1$)
    Select Case TypDrive
        Case 3: twardy = True
        Case Else: twardy = False
    End Select
   
    If twardy Then
        hhd = d1$
    Else
        cdrom = d1$
        End If
    p% = InStr(Disques, Chr$(0))
Wend
If cdromek Then
dyski = cdrom
Else
dyski = hhd
End If

03-08-2004 16:03
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Spróbuj porównać to z moim kodem:

    Dim strSave As String
    Dim ret As Long
    Dim Counter As Integer
 
    strSave = String(255, Chr$(0))

    ret& = GetLogicalDriveStrings(255, strSave)

    For Counter = 1 To 100
       
            If Left(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then
                Exit For
            End If
           
            ReDim Preserve Drive(1 To Counter)

            Drive(Counter) = Left(strSave, InStr(1, strSave, Chr$(0)) - 1)
            strSave = Right(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
               
    Next Counter


Ten fragment kodu działa na bank w 98 i XP

Jeżeli chodzi o funkcję GetDriveType to nie miałem okazji jej wykorzystać także nie wiem co i jak z nią.

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

03-08-2004 18:21
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Właśnie przetestowałem funkcję DetDRiveType i działa na XP także

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

03-08-2004 18:31
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
anonim




Typ: Nie zarejestrowany

Wiec kod teraz wyglada tak..

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Function dyski(Optional cdromek As Boolean = False)
Dim Disques As String
Dim TypDrive As Long
    Dim strSave As String
    Dim ret As Long
    Dim Counter As Integer
Dim twardy As Boolean
Disques = String$(128, Chr$(0))
ret& = GetLogicalDriveStrings(255, strSave)
strSave = String(255, Chr$(0))
    For Counter = 1 To 100
       
            If Left(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then
                Exit For
            End If
           
            ReDim Preserve Drive(1 To Counter)

          Drive(Counter) = Left(strSave, InStr(1, strSave, Chr$(0)) - 1)
            strSave = Right(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
               
    Next Counter
    If twardy Then
        hhd = d1$
    Else
        cdrom = d1$
        End If
    p% = InStr(Disques, Chr$(0))
Wend
If cdromek Then
dyski = cdrom
Else
dyski = hhd
End If




End Function

Dopiero wsumie zaczynam z VB i nie moge sobie z tym poradzic:/....(powyzszy kod nie dziala oczywiscie)....za pomoc z gory  dziekuje

04-08-2004 23:59
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

ret& = GetLogicalDriveStrings(255, strSave)
strSave = String(255, Chr$(0))

Zamień to miejscami


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

05-08-2004 00:06
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Dim TypDrive As Long
Dim strSave As String
Dim ret As Long
Dim Counter As Integer
Dim twardy As Boolean
Dim Drive() As String

strSave = String(255, Chr$(0))
ret& = GetLogicalDriveStrings(255, strSave)
    For Counter = 1 To 100
       
            If Left(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then
                Exit For
            End If
           
            ReDim Preserve Drive(1 To Counter)

          Drive(Counter) = Left(strSave, InStr(1, strSave, Chr$(0)) - 1)
            strSave = Right(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
         
          TypDrive = GetDriveType(Drive(Counter))
         
    Select Case TypDrive
    Case 3
            twardy = True
    Case Else
            twardy = False
   
    End Select

MsgBox "Dysk " & Drive(Counter) & " jest dyskiem twardym? - " & twardy

Next Counter

Obadaj ten fragment kodu


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

05-08-2004 10:41
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
anonim




Typ: Nie zarejestrowany

ah.....Zapodaje kod i mowie co i jak:
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Function dyski(Optional cdromek As Boolean = False)
Dim Disques As String
Dim TypDrive As Long
Dim strSave As String
Dim ret As Long
Dim Counter As Integer
Dim twardy As Boolean
Dim Drive() As String

strSave = String(255, Chr$(0))
ret& = GetLogicalDriveStrings(255, strSave)
    For Counter = 1 To 100
       
            If Left(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then
                Exit For
            End If
           
            ReDim Preserve Drive(1 To Counter)

          Drive(Counter) = Left(strSave, InStr(1, strSave, Chr$(0)) - 1)
            strSave = Right(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
         
          TypDrive = GetDriveType(Drive(Counter))
         
    Select Case TypDrive
    Case 3
            twardy = True
    Case Else
            twardy = False
   
    End Select

MsgBox "Dysk " & Drive(Counter) & " jest dyskiem twardym? - " & twardy'to nie jest mi potrzebne

Next Counter
If cdromek Then
dyski = cdrom
Else
dyski = hhd
End If
End Function
Private Sub Command1_Click()
Dim wynik

Dim szukane
Dim litera
Dim SZ
Dim dysk(6)
Dim x
'wyciaganie pierwszego znaku
SZ = Left(Drive, 1)'tu niestety zawsze jest "c"
'wyciagniecie pozycji znaku (wartosc cyfrowa)
litera = "cdefgh"
szukane = SZ
wynik = InStr(litera, szukane)
Label1.Caption = wynik
---------------------------------------
Problem polega na tym ,iz funkcja powinna zwracac litere ostatniej partycji dyskowej a zwraca  pierwsza........
PS:nie potrzebne mi sa litery napedow

05-08-2004 17:41
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

1. SZ = Left(Drive, 1) 'tu niestety zawsze jest "c"

Jeżeli to to samo Drive, które jest w funkcji dyski to powinieneś zadeklarować zmienną Drive poza funkcją dyski aby była dostępna dla wszystkich funkcji i procedur w module.

Poza tym zmienna Drive jest tablicą także aby wyciągnąć konkretną literę dysku, musisz ją indeksować


2. MsgBox "Dysk " & Drive(Counter) & " jest dyskiem twardym? - " & twardy'to nie jest mi

To miało być do zobrazowania jak to działa

3. Nie wiem czy tak robisz ale zanim naciśniesz Command1 musisz wywołać funkcję dyski aby do zmiennej Drive() zostały przypisane litery dysków.

4. "Problem polega na tym ,iz funkcja powinna zwracac litere ostatniej partycji dyskowej a zwraca  pierwsza........
PS:nie potrzebne mi sa litery napedow"

Nie rozumiem - to chcesz uzyskać w wyniku literę czy nie ??

5. Tablica Drive() wyglada tak:

Drive(1) = "a:\" - chyba że nie masz stacji dyskietek
Drive(2) = "c:\"
Drive(3) = "d:\"
Drive(4) = "e:\"
Drive(5) = "f:\"

Może napisz co konkretnie chcesz uzyskać to pomyślimy

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

05-08-2004 18:06
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
anonim




Typ: Nie zarejestrowany

Chcem aby SZ = Left(Drive, 1) dawalo ostatnia litere istniejacych partycji.
Np.Ja posiadam 4 partycje  c,d,e,f wiec rezultat
powinien byc f.

05-08-2004 19:58
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

W takim razie musisz zapamiętać ostatnią wartość licznika czyli Counter w funkcji dyski

Pamiętaj, że aby dana zmienna była dostępna dla innych funkcji i procedur w danym module musi być zadeklarowana poza jakąkolwiek funkcją lub procedurą czyli nie może być zadeklarowana w w funkcji dyski.

Jeżeli chcesz zapamietać literę ostatniego dysku twardego to jeżeli funkcja API GetDriveType zwróci wartość np. 5, wyjdź z funkcji (zapamiętaj wartość Counter) i zmniejsz go o jeden

Przykładowo:

Masz na kompie:
Wartość Counter:

1. a:
2. c: - twardy
3. d: - twardy
4. e: - twardy
5. f: - twardy
6. g: - stacja CDROM

Gdy Drive(6)="g:\" funkcja GetDriveType zwróci wartość 5

Wychodzisz z petli For

Zmniejszasz Counter o jeden czyli Counter = 5
i w Drive(5) otrzymujesz ostatnią literę dysku twardego

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

05-08-2004 21:04
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
anonim




Typ: Nie zarejestrowany

hym wszystko bylo by dobrze, ale jak ktos bedzie mial dwa napedy??WYSTAPI BLAD!Dlatego zalezy mi na tym zeby funkcja nie odczytywala liter napedow takich jak CD-ROM czy FDD itd.

05-08-2004 23:13
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Nie rozumiem - jaki błąd wystąpi?


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

05-08-2004 23:38
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
anonim




Typ: Nie zarejestrowany

mniejsza o ten blad......chem ,aby funkcja zwracala tylko litere ostaniej dostepnej partycji....bez CD-ROM i FDD.O to przyklad(nie sety nie dzialal na XP...twoja funkcja dziala ale dalej nie wiem jak wyciagnac ta porzadana litere .....

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Function dyski(Optional cdromek As Boolean = False)
Dim Disques As String
Dim RetVal As Long
Dim TypDrive As Long
Dim twardy As Boolean
Disques = String$(128, Chr$(0))
RetVal = GetLogicalDriveStrings(128, Disques)
Disques = Left$(Disques, RetVal)
p% = InStr(Disques, Chr$(0))
While p% <> 0
    d1$ = Left$(Disques, p% - 1)
    Disques = Right$(Disques, Len(Disques) - p%)
    TypDrive = GetDriveType(d1$)
    Select Case TypDrive
        Case 3: twardy = True
        Case Else: twardy = False
    End Select
   
    If twardy Then
        hhd = d1$
    Else
        cdrom = d1$
        End If
    p% = InStr(Disques, Chr$(0))
Wend
If cdromek Then
dyski = cdrom
Else
dyski = hhd
End If
End Function
Private Sub Command1_Click()
Dim wynik

Dim szukane
Dim litera
Dim SZ
Dim dysk(6)
Dim x
'wyciaganie pierwszego znaku
SZ = Left(dyski, 1)'i wlasnie tu owa funkcja zwracala litere ostaniej dostepnej partycji
'wyciagniecie pozycji znaku (wartosc cyfrowa)
litera = "cdefgh"
szukane = SZ
wynik = InStr(litera, szukane)

06-08-2004 00:45
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Dim Drive() As String

Function dyski(Optional cdromek As Boolean = False) As Integer
Dim Disques As String
Dim TypDrive As Long
Dim strSave As String
Dim ret As Long
Dim Counter As Integer
Dim twardy As Boolean

strSave = String(255, Chr$(0))
ret& = GetLogicalDriveStrings(255, strSave)
    For Counter = 1 To 100
       
            If Left(strSave, InStr(1, strSave, Chr$(0))) = Chr$(0) Then
                Exit For
            End If
           
            ReDim Preserve Drive(1 To Counter)

          Drive(Counter) = Left(strSave, InStr(1, strSave, Chr$(0)) - 1)
            strSave = Right(strSave, Len(strSave) - InStr(1, strSave, Chr$(0)))
         
          TypDrive = GetDriveType(Drive(Counter))
               
If TypDrive = 5 And cdromek = False Then
                            dyski = Counter - 1
                            Exit Function
End If

Next Counter


If cdromek Then
        dyski = cdrom
End If

End Function
Private Sub Command1_Click()
Dim wynik

Dim szukane
Dim litera
Dim SZ As String
Dim dysk(6)
Dim x
'wyciaganie pierwszego znaku
SZ = Left(Drive(dyski), 1)
'wyciagniecie pozycji znaku (wartosc cyfrowa)
litera = "cdefgh"
wynik = InStr(1, litera, SZ, vbTextCompare)
Label1.Caption = wynik
End Sub

Teraz funkcja zwraca ostatnią literę dysku a wynik pozycję w stringu litera


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

06-08-2004 10:20
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Sorki - zwraca pozycję ostatniego dysku w Drive(Counter)

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

06-08-2004 10:23
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
anonim




Typ: Nie zarejestrowany

Uffff....wszystko dziala nareszcie poprawnie...
Wielkie dzieki...sorx ze tak ciezko to szlo ale dopiero zaczynamJeszcze raz thenx!!!

06-08-2004 13:14
  
DJK



Typ: neutral
Postów: 871
Zarejestrowany: Feb 2004

Nie ma sprawy - po to jest to forum

Pozdrawiam


_____________________________________________
Jeśli można coś zrobić w sposób optymalny to czemu nie

06-08-2004 13:28
Pokaż profil DJK  Wyślij email do DJK   Odwiedź stronę DJK  
Wszystkich odpowiedzi: 16 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1