چطور محتوای یک فایل txt بدست بیاریم

[xrezax]

دوستان همونطور که میدونید وقتی یه فایل تکست با NotePad باز میشه Title اون اینجوریه
Filename.txt - Notepad حالا من می خوام به برنامه بگم که هر موقع همچین متنی دید برنامه یک کپی از محتویاتش بگیره و کنار برنامه در یک txt ذخیره کنه.

ممنون میشم سورس بزارید واسم

[محسن واژدی]

سلام علیکم

ضمیمه زیر را بررسی کنید

برای استفاده ماژول کد mdlGetAllNP_DATA را به برنامه منتقل کنید کافی هست

البته کد نمونه در سورس وجود دارد، ولی خب شاید توضیحات زیر مفید باشد:


GetAllNotepadsText: نام روال اصلی است که برای شروع احضار میکنیم، و شامل دو آرگومان است:

cCollection: یک شی کالکشن که محتوی notepad های یافت شده را نگهداری می کند
sNotepadWinTitle: اگر بخواهیم تابع بر روی notepadیی با عنوان خاصی تمرکز داشته باشد عنوان را در این آرگومان جایگزین میکنیم، اگر مشخص نشود محتوی تمامی notepadهای یافت شده برگردانده میشوند


با کمی تغییر در کدهای ماژول میتوانیم عنوان notepadهای یافت شده را هم در کالکشن یا دیکشنری ذخیره کنیم
برای ذخیره یافته ها بر روی دکمه "save founds" کلیک می کنیم



موفق باشید

[xrezax]

ممنون از جواب خوب و کاملتون .

حالا اگه ممکنه برام تکمیلی کنی .
می خوام برنامه خودش بفهمه که فایل txt باز شده وسیوش کنه و فایل تکراری هم سیو نکنه. یعنی اگر فایل txt سیو کرده باشه و بار دوم اون فایل دوباره باز بشه دیگه سیوش نکنه.

[محسن واژدی]

می خوام برنامه خودش بفهمه که فایل txt باز شده وسیوش کنه و فایل تکراری هم سیو نکنه. یعنی اگر فایل txt سیو کرده باشه و بار دوم اون فایل دوباره باز بشه دیگه سیوش نکنه.
به این صورت که می فرمائید ممکن هست کار کمی مشکلتر شود، هم میتوانیم پیش از ذخیره فایل های ذخیره شده را باز و با دستوری مشابه زیر آن ها را با محتوی فعلی مقایسه کنیم، که البته این ممکن هست با تغییر حجم داده ها بر روی سرعت برنامه تاثیرگذار باشد:


Private Sub Command1_Click()
Open "D:\tst.txt" For Input As #1
If Input(LOF(1), 1) = "Sample text" Then
'our commands
End If
Close #1
End Sub
موفق باشید

[xrezax]

میشه سورسو ادیت کنید برام.
ممنونت میشم

[محسن واژدی]

کد زیر را در ماژول کپی کنید:

Function ChkAlreadySaved(sCurContents$) As Boolean
On Error Resume Next
Dim i, fr%, sCF$, sDt$
fr% = FreeFile
Do
i = i + 1
sCF$ = App.Path & "\" & i & ".txt"

If Dir(sCF$) = "" Then Exit Function

Open sCF$ For Binary As #fr%

sDt$ = input(LOF(fr%), fr%)

If LCase(sDt$) = LCase(sCurContents$) Then
ChkAlreadySaved = True
Close fr%
Exit Function
End If
Close fr%
Loop
End Functionدر پارامتر sCurContents محتوی فعلی که قصد ذخیره کردن آنرا داریم قرار میدهیم، تابع اگر در هر یک از فایل های موجود این محتوی وجود داشته باشد مقدار True را برمیگرداند که در نتیجه ی آن محتوی فعلی را ذخیره نمیکنیم

برای مثال:

If Not ChkAlreadySaved("Sample text") Then
'our save commands
End Ifموفق باشید

[xrezax]

شرمنده اینقدر سوال می کنم.
حالا اگه بخوام هر محتوای نوت پد باز شده رو توی یک text قرار بدم چی ؟؟
می خوام طوری بشه اگر چندتا نوت پد همزمان باز بود محتویاتشون بریزم داخل text :قلب:
و دیگه کنار برنامه سیو نشن.

[محسن واژدی]

شرمنده اینقدر سوال می کنم.
حالا اگه بخوام هر محتوای نوت پد باز شده رو توی یک text قرار بدم چی ؟؟
می خوام طوری بشه اگر چندتا نوت پد همزمان باز بود محتویاتشون بریزم داخل text :قلب:
و دیگه کنار برنامه سیو نشن.
خواهش میکنم،
در تابع GetAllNotepadsText هم نتیجه در یک Collection ذخیره میشود، پس در اینصورت میتوانیم تعدادی Text-Box آرایه ایجاد و با حلقه ای (برای مثال For) محتوی موجود در collection را گرفته و در text-boxیی با همان index بریزیم

[xrezax]

میشه ایدیتش کنید. :قلب: من زیاد با این توابع کار نکردم .

[محسن واژدی]

نمونه زیر را بررسی کنید، البته کمی ساده است

موفق باشید

[xrezax]

چرا وقتی یک کامند به فرم اضافه می کنم و دستور زیر را برای جابجا کردن متن در تکست ها براش می نویسم کار نمی ده ???

Text1.Text = Text2.Text

[محسن واژدی]

چرا وقتی یک کامند به فرم اضافه می کنم و دستور زیر را برای جابجا کردن متن در تکست ها براش می نویسم کار نمی ده ???

Text1.Text = Text2.Text

اگه از سورس پست قبل استفاده می کنید، شاید شاخص Text1 را انتخاب نکردین (برای مثال Text1(0).Text=Text2.Text)

[xrezax]

کار نمی کنه :ناراحت:

Text2.Text = Text1(0).Text
--------------------------------------------------------

من می خوام بجای ده تا text از یه text1.text استفاده کنم.
بعد از text1.text به text2.text منتقل کنم

[محسن واژدی]

نمونه زیر بررسی کنید

موفق باشید

[xrezax]

آقا ممنون حل شد.

فقط میشه این توابع را برام عوض کنید. آنتی ویروس آویرا بهشون گیر می ده. ( با اینکه ویروس نیست)

میشه زحمت بکشی و طور دیگه ای کدشو بنویسید.

به این چهارتا گیر می ده

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

[محسن واژدی]

آقا ممنون حل شد.

فقط میشه این توابع را برام عوض کنید. آنتی ویروس آویرا بهشون گیر می ده. ( با اینکه ویروس نیست)

میشه زحمت بکشی و طور دیگه ای کدشو بنویسید.

به این چهارتا گیر می ده

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long


جلایگزین GetWindowText میتواند تابع SendMessage باشد:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Sub Command1_Click()
Dim sWT$
sWT$ = String(50, Chr(0))
SendMessage hwnd, &HD, 50, sWT$
sWT$ = Left(sWT$, InStr(1, sWT$, Chr(0)) - 1)
End Sub
در مورد FindWindow/Ex و GetClassName راه حل ساده ای به نظرم نمیرسد :)

موفق باشید

[xrezax]

آقای واژدی من می تونم کدی نویسم که نوت پد را تشخیص بدم.

شما فقط یک کاری برام انجام بدین. یک text و command بزارید توی یک فرم. طوری که اگه روی کامند کلیک کنم محتوای txt بیاد توی text همین. باقیش با من!!!!

[محسن واژدی]

... یک text و command بزارید توی یک فرم. طوری که اگه روی کامند کلیک کنم محتوای txt بیاد توی text همین. باقیش با من!!!!
سلام
بخش آبی رنگ درخواستتون متوجه نشدم در صورت امکان بیشتر توضیح دهید

[xrezax]

منظورم محتوای نوت پد را به text1.text منتقل کنه.

------------------------------
توضیح کلی ...
من می تونم نوت پد را تشخیص بدم. یعنی اسمشو می تونم توی یک تکست بنویسم. یعنی قسمت اول دستور.
حالا می مونه انتقالش به text1.text که ممنون میشم زحمتشو برام بکشین.

چون نمی تونم از این توابع استفاده کنم.

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

[xrezax]

همچنان در حالت انتظار ...

[محسن واژدی]

سلام،
توابعی که در پست های قبلی عرض شد این کار رو انجام میدن البته بجز Avira که فرمودین ندیده ام با آنتی ویروس/فایروال های دیگه مشکلی داشته باشند
البته مانع شدن avira میتواند طبیعی هم باشد چرا که برنامه عملکردی مشابه کرم ها و key-loggerها انجام میدهد

[xrezax]

حالا شما اگه ممکنه اون قسمتی که من خواستمو تعیین کنین واسم ممنونت میشم. خودم دیگه کاراشو می کنم

[محسن واژدی]

حالا شما اگه ممکنه اون قسمتی که من خواستمو تعیین کنین واسم ممنونت میشم. خودم دیگه کاراشو می کنم
سلام علیکم
واقعیتش، متوجه این بخش از توضیحاتتون نشدم:


من می تونم نوت پد را تشخیص بدم. یعنی اسمشو می تونم توی یک تکست بنویسم. یعنی قسمت اول دستور.

[xrezax]

یعنی من می تونم اسم پنجره نوت پد را توی برنامه تشخیص بدم. یعنی اگر reza.txt اجرا شد داخل text برنامه بنویسه reza.txt - Notepad

[just4froum]

ببین کارت با این راه می افته ؟

البته روش درستش اونیه که جناب واژدی نوشتن ولی این برنامه اون تابع هایی رو که می خوای توش به کار نبردم.

راستی یه جای کد نوشتم x = x + 1 و if x = 150 then exit do اون قسمتو حذف کن . ویندوز من به مشکل خورده با این برنامه هنگ می کنه به خاطر همین اون قسمت رو نوشتم.:گیج:

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const GW_CHILD As Long = 5
Private Const GW_HWNDNEXT As Long = 2

Dim NhWnd() As Long

Private Function FindText(hWnd As Long) As String
Dim lbuf As Long, buf As String
lbuf = SendMessage(hWnd, WM_GETTEXTLENGTH, 0&, 0&)
lbuf = lbuf + 1
buf = String(lbuf, Chr(0))
Call SendMessage(hWnd, WM_GETTEXT, lbuf, ByVal buf)

FindText = Left(buf, lbuf)
End Function

Private Sub Command1_Click()
Dim MhWnd As Long, chWnd As Long, x As Long

Erase NhWnd
Text1.Text = Empty

MhWnd = GetDesktopWindow
chWnd = GetWindow(MhWnd, GW_CHILD)

Do While chWnd <> 0
x = x + 1
If x = 150 Then Exit Do
If InStr(1, LCase(FindText(chWnd)), "notepad") <> 0 Then AddHwnd (chWnd)
chWnd = GetWindow(chWnd, GW_HWNDNEXT)
Loop


For x = 1 To UBound(NhWnd)
chWnd = GetWindow(NhWnd(x), GW_CHILD)
Do While chWnd <> 0
If FindText(chWnd) <> Empty Then Text1.Text = Text1.Text & FindText(chWnd)
chWnd = GetWindow(chWnd, GW_HWNDNEXT)
Loop
Text1.Text = Text1.Text & vbNewLine & String(50, "_") & vbNewLine & vbNewLine
Next x
End Sub


Private Sub AddHwnd(hWnd As Long)
If (Not NhWnd) = -1 Then
ReDim NhWnd(1 To 1) As Long
NhWnd(1) = hWnd
Else
ReDim Preserve NhWnd(1 To UBound(NhWnd) + 1) As Long
NhWnd(UBound(NhWnd)) = hWnd
End If
End Sub

[xrezax]

ممنون بابت کمکت .
کد شمارو چک کردم یه مشکل کوچولو داره اونم وقتی Command1 رو چندبار می زنم تعداد گرفتن متن نوت پد بیشتر از دفعاتیه که کلیک می کنم.

بی زحمت اجراش کنید تا منظورمو بفهمین.

راهی هم هست که بشه اگر یک txt باز شد فقط یک بار متنشو بگیره حتی اگر چند بار روی کامند کلیک کنم فقط یکبار منتقل بشه.

[just4froum]

کد رو ویرایش کردم ولی vb نداشتم که چک کنم ولی فکر کنم درست شد.

[xrezax]

ببین کارت با این راه می افته ؟

البته روش درستش اونیه که جناب واژدی نوشتن ولی این برنامه اون تابع هایی رو که می خوای توش به کار نبردم.

راستی یه جای کد نوشتم x = x + 1 و if x = 150 then exit do اون قسمتو حذف کن . ویندوز من به مشکل خورده با این برنامه هنگ می کنه به خاطر همین اون قسمت رو نوشتم.:گیج:

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const GW_CHILD As Long = 5
Private Const GW_HWNDNEXT As Long = 2

Dim NhWnd() As Long

Private Function FindText(hWnd As Long) As String
Dim lbuf As Long, buf As String
lbuf = SendMessage(hWnd, WM_GETTEXTLENGTH, 0&, 0&)
lbuf = lbuf + 1
buf = String(lbuf, Chr(0))
Call SendMessage(hWnd, WM_GETTEXT, lbuf, ByVal buf)

FindText = Left(buf, lbuf)
End Function

Private Sub Command1_Click()
Dim MhWnd As Long, chWnd As Long, x As Long

Erase NhWnd
Text1.Text = Empty

MhWnd = GetDesktopWindow
chWnd = GetWindow(MhWnd, GW_CHILD)

Do While chWnd <> 0
x = x + 1
If x = 150 Then Exit Do
If InStr(1, LCase(FindText(chWnd)), "notepad") <> 0 Then AddHwnd (chWnd)
chWnd = GetWindow(chWnd, GW_HWNDNEXT)
Loop


For x = 1 To UBound(NhWnd)
chWnd = GetWindow(NhWnd(x), GW_CHILD)
Do While chWnd <> 0
If FindText(chWnd) <> Empty Then Text1.Text = Text1.Text & FindText(chWnd)
chWnd = GetWindow(chWnd, GW_HWNDNEXT)
Loop
Text1.Text = Text1.Text & vbNewLine & String(50, "_") & vbNewLine & vbNewLine
Next x
End Sub


Private Sub AddHwnd(hWnd As Long)
If (Not NhWnd) = -1 Then
ReDim NhWnd(1 To 1) As Long
NhWnd(1) = hWnd
Else
ReDim Preserve NhWnd(1 To UBound(NhWnd) + 1) As Long
NhWnd(UBound(NhWnd)) = hWnd
End If
End Sub


من این سورس خیلی بدردم خورد. اما یه مشکلی داره اونم اینه که هر تکست رو باز کنم چند بار ذخیره میشه.
خواستم ببینم اگر امکانش هست محسن واژدی این سورسو توی برنامه که توی پست 14 گذاشتن جایگزین کنن . ممنون میشم

[محسن واژدی]

سلام علیکم
ضمیمه زیر تلفیقی از ضمیمه پست 21 و سورس جناب just4froum هست
البته استفاده نکردن از GetClassName میتونه مشکلاتی ایجاد کنه، که البته زیاد هم ضروری نیست

موفق باشید

[xrezax]

موقع سیو کردن و exe گرفتن به NhWnd گیر میده و خروجی نمیده vb
یه مشکلی که داره txt های تکراری رو ذخیره می کنه. من می خوام هر تکسی که باز شد فقط یک بار ذخیره بشه و اگر چندین بار باز شد فقط یک بار نشون بده.
یه خورده جمع و جور نیست.

[xrezax]

کسی نظری نداره