با سلام خدمت دوستان عزیز

این سایت آموزش هک یاهو هست خیلی سایت خوبی هست برنامه هاش تست شده هست

در ضمن اسپمر بلاگفا هم تو این سایت هست

www.rps-hack.blogfa.com

با سلام امروز ۵ فروردین ۸۸ و من از خدمت برگشتم تا در خدمت شما دوستان و دشمنان و ... باشم با مطالبی تازه و جدید در هر هفته

جک و داستان های باحال

چند تا جک دیگه هم واستون گذاشتم برید تعریف کنید

ضایع بشید باشه

1- تركه به رفيقش ميگه: ميخوام دختر شاه رو بگيرم! رفيقش ميگه: چرت نگو مومن! مگه كشكيه؟! تركه ميگه: بابا من كه راضيم، ننم هم كه راضيه، فقط مونده شاه و دخترش!

2- اصفهانيه داشته تو خيابون ميرفته كه يهو ميبينه اوضاع دل و روده خرابه و به شدت نياز به قضاي حاجت داره! خلاصه يخورده اطراف چرخ ميزنه تا آخر يك توالت عمومي پيدا ميكنه. خوشحال و خندان ميره تو كه يهو دم در يك مردك لندهور جلوشو ميگيره، ميگه: كجا عمو؟! اينجا توالتش ورودي داره، 200 تومن! اصفهانيه شاكي ميشه، ميگه: انصافتو شكر! يك ريدن دويست تومن؟! نميخوام! خلاصه مياد بيرون، يكم ديگه چرخ ميزنه ميبينه نه اوضاع خيلي خرابه، برميگرده، ميگه: درك بيا اينم دويست تومن. يارو ميگه: نـُچ! نرخا بالا رفته، ورودي جديد 500 تومنه! اصفهانيه تا فيهاخالدونش ميسوزه، ميگه: يعني چي؟! مگه سر گردنست؟! آدم به خودش برينه به صرفه‌تره! خلاصه باز شاكي مياد بيرون، يكم راه ميره، ميبينه الانه كه وسط آدم و عالم برينه به خودش، زود بر ميگرده، باحال زار يك پونصدي ميده، ميگه: بيا بابا اينم 500 تومن. باز صاب توالت يك ابرو ميندازه بالا، ميگه: تــُـچ! چون تو مضيقه‌اي وروديت ميشه هزار تومن! اصفهانيه كه ديگه عرق از بناگوشش سرازير شده بوده، ميگه: بابا سگ خور! بيا اينم هزار تومن، بزار برم برينم! خلاصه ميره تو. مردك توالت‌چي(!) ميبينه يك ربع گذشت، نيم ساعت گذشت، يك ساعت گذشت، آقا نيومد بيرون. ميره در توالت رو باز ميكنه، ميبينه اصفهانيه با كمربند خودشو دار زده، يك يادداشت هم گذاشته كه: "كسي كه تو اين گروني فرق گوز و ان رو نميفهمه فقط واسه مردن خوبه"!

3- تركه شاكي ميره ثبت‌احوال، ميگه: آقا اين اسم من خيلي ضايست، بايد حتماٌ عوضش كنم. كارمنده ازش ميپرسه، مگه اسمتون چيه؟ تركه ميگه: اصغرِ ان‌چهره! كارمنده ميگه: آره خوب حق داريد، بايد حتماً عوضش كنيد. حالا چه اسمي ميخوايد بگذاريد؟ تركه ميگه: اكبرِ ان‌چهره!

4- تركه پرتقال خوني ميخوره، ايدز ميگيره!

5- از تركه ميپرسن: ميدوني USA مخفف چيه؟ ميگه: يوم‌الله سيزده آبان!

6- تركه رفته بوده تماشاي مسابقه دو و ميداني، وسط مسابقه از بغليش ميپرسه: ببخشيد، اينا واسه چي دارن ميدون؟! يارو ميگه: براي اينكه به نفر اول جايزه ميدن. تركه يوخده فكر ميكنه، ميپرسه: پس بقيشون واسه چي دارن ميدون؟!

7- تركه ساعت سه نصفِ شب زنگ ميزنه صدا و سيما، ميگه: ببخشيد آقا به نظرِ شما الان آقاي خامنه‌اي خوابه؟ يارو ميگه: نميدونم ولي احتمالاً بايد خواب باشن. تركه ميگه: معذرت ميخوام؛ ولي آقاي رفسنجاني چي، ايشون هم خوابه؟ يارو ميگه: نميدونم ولي يحتمل ايشون هم خواب باشن. تركه ميگه: ببخشيد ولي آقاي خاتمي چي؟ يارو ميگه: احتمالاً ايشون هم خواب هستن، چطور؟ تركه ميگه: پس دمت گرم حالا كه همه اينا خوابن يه شو هندي بذار حال كنيم!

8- تركه ميميره، اون دنيا در حيني كه داشتن به حساب كتاباش رسيدگي ميكردن ميره پيش جبرئيل، ميگه: من از خدا يك سوال واجب دارم، ميشه برم بپرسم؟ جبرئيل ميگه: باشه، برو طبقه بالا در سمت راست، سوالت رو بپرس، زود برگرد. تركه ميره طبقه بالا، در رو باز ميكنه، ميبينه خدا پشت يك ميز نشسته داره با يكي از فرشته‌ها به حساباي مردم ميرسه. خلاصه سلام ميكنه ميره جلو، ميگه: خداجان، الهي گربان او بزرگيت بشم من، الهي فدات بشم... چرا تو دنيا اين همه ترك آفريدي؟! بري تو آذربايجان همه تركند، بري تهران پر تركه، بري بلوچستان، بري شمال، بري جنوب، غرب، شرق، بازم ترك پيدا ميشه... بري آلمان بازم ترك پيدا ميشه، بري كانادا، بري آمريكا بازم ترك پيدا ميشه... بري كره ماه بازم ترك پيدا ميشه! آخه خداجان، واسه چي اينقدر ترك آفريدي؟! خدا يكم تركه رو نگاه ميكنه، به معاونش ميگه: اصگر... ايلده ببين اين چي ميگه بابا... هي وگت مارو ميگيرند!

9- تركه تصادف ميكنه، ملت علاف ميريزن دورش و شروع ميكنن نظر كارشناسي دادن. بالاخره بعد يك مدت افسر راهنمايي مياد، منتها اونقدر ملت هركدوم واسه خودشون چرت و پرت ميگفتن كه صداي افسره به جايي نميرسيده. تركه شاكي ميشه، داد ميزنه: ساكت.. ساكت... ايلده ديگه اينجا كسي جز جناب سروان حق گه خوردن نداره!

10- تركه ميرسه سر يك صحنه تصادف، از يكي ميپرسه: ببخشيد قربان، اينجا چه خبره؟ يارو هم ميگه: هيچي آقا، اين بدبخت گوزپيچ شده! تركه ميره تو فكر، بعد يك مدت يك بنده خداي ديگه مياد از تركه ميپرسه: ببخشيد اينجا چي شده؟ تركه ميگه: ايلده منم خوب نفهميدم، نميدونم اين بابا پيچيديه گوزيده، گوزيده پيچيده، سر پيچ گوزيده؟!

11- تركه زنگ ميزنه فلسطين، ميبينه اشغاله!

12- از تركه ميپرسن: مساحت ايران چقدره؟ ميگه: 1648192 متر مكعب! ميگن: خنگ خدا، آخه چرا متر مكعب؟! تركه ميگه: آخه بعد انقلاب به ارتفاع يك متر ريده شده توش!

13- تركه سوار آسانسور ميشه، ميبينه نوشته‌: ظرفيت 12 نفر. باخودش ميگه: عجب بدبختيه‌ها! حالا 11 نفر ديگه از كجا بيارم؟!

14- تركه ميميره، باباش رضايت نميده!

15- از تركه ميپرسن: به نظر شما اگه آمريكا افغانستان و عربستان رو بگيره، به كره و چين هم حمله كنه تكليف ايران چي ميشه؟ تركه ميگه: ايلده چي ميشه نداره كه، ايران ميره جام جهاني!

16- لره داشته با تمام وجود وضو ميگرفته و دستاشو محكم ميكشيده رو هم، ازش ميپرسن: چرا اينقدر محكم وضو ميگيري؟ ميگه: چني آرم وضو ميرم كه هيچ گوزي نتنِه باطلش كنه!

17- تركه ميگوزه، دنبال پوكش مي‌گرده!

18- از تركه ميپرسن: چند تا بچه داري؟ 4 تا از انگشتاشو نشون ميده، ميگه: 3 تا! ملت كف ميكنن، ميگن: بابا اينا كه 4تاست؟ تركه انگشت كوچيكشو نشون ميده، ميگه: اين بچه همسايمونه، ولي هميشه خونه ماست!

19- لره داروخونه داشته، يك روز جلو در مغازه بزرگ مينويسه: سوسك كش جديد رسيد! خلاصه بعد يك مدت يك بابايي مياد تو ميگه: ببخشيد، جريان اين سوسك‌كش جديد چيه؟ اين خونه ما رو سوسك سر گرفته. لره ميگه: اين دارو خيلي جديده و بازدهيش هم تضمينيه. شما اين دارو رو ميريزيد تو يك قطره چكون، بعد كشيك ميكشيد تا سوسكها رو بگيريد. هر سوسك رو كه گرفتيد، در روز سه نوبت (صبح و ظهر و شب) تو هر چشمش دو قطره ازين دارو ميچكونيد، بعد از يك مدت سوسكها كور ميشن و خودشون از گشنگي ميميرن! يارو كف ميكنه، ميگه: خوب آخه اگه سوسكها رو بگيريم كه همونجا درجا مي‌كشيمشون! لره ميره تو فكر، بعد يك مدت ميگه: آره خوب، ازون راهم مِشِه!

20- آبادانيه ميخواسته بره خواستگاري، ديرش شده بوده حواسش پرت ميشه شلوارش رو پشت و رو ميپوشه و با عجله ميدوه تو خيابون، يهو يك ماشين مياد ميزنه درازش ميكنه وسط خيابون. رانندهه مياد بالا سرش، ميگه: طوريت كه نشده؟ آبادانيه يك نگاه به سر تا پاش ميكنه، چشمش ميافته به شلوارش، ميگه: چي چيو طوري نشده، ولك زدي حسابي پيچوندي!

نطر در مورد وبلاگ

اگر مي خواهيداين روند ادامه داشته باشد

پس لطف کنید نظر بدهید

با تشکر

<<مرد تنها>>

کدی برای تست روشن بودن چراغ های سه گانه

public
procedure CheckCapslock;
procedure CheckNumlock;
procedure CheckInslock;
procedure CheckScrlock;
{ public declarations }
end;

procedure TForm1.CheckCapslock;
begin
if Odd (GetKeyState (VK_CAPITAL)) then
StatusBar1.Panels[1].Text := 'Caps'
else
StatusBar1.Panels[1].Text := '';
end;

procedure TForm1.CheckNumlock;
begin
if Odd (GetKeyState (VK_NUMLOCK)) then
StatusBar1.Panels[2].Text := 'Num'
else
StatusBar1.Panels[2].Text := '';
end;

procedure TForm1.CheckInslock;
begin
if Odd (GetKeyState (VK_INSERT)) then
StatusBar1.Panels[3].Text := 'Ins'
else
StatusBar1.Panels[3].Text := '';
end;

procedure TForm1.CheckScrlock;
begin
if Odd (GetKeyState (VK_SCROLL)) then
StatusBar1.Panels[4].Text := 'Scr'
else
StatusBar1.Panels[4].Text := '';
end;

procedure TForm1. Timer1Timer(Sender: TObject);
begin
CheckCapslock;
end;

procedure TForm1. Timer2Timer(Sender: TObject);
begin
CheckNumlock;
end;

procedure TForm1. Timer3Timer(Sender: TObject);
begin
CheckInslock;
end;

procedure TForm1. Timer4Timer(Sender: TObject);
begin
CheckScrlock;
end;

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

به شما پاسخ داده شود لطفا نظر یادتون نرود

باتشکر <<مرد تنها>>

 

کدی برای بزرگ کردن حرف اول در ادیت باکس ها

procedure TForm1.DBEdit1Change(Sender: TObject);
var

Cursor : Integer;
begin
if DBEdit1.Text <> '' then
begin
Cursor:=DBEdit1.SelStart;
DBEdit1.Text := UpperCase(Copy(DBEdit1.Text,1,1)) +
LowerCase(Copy(DBEdit1.Text,2,Length(DBEdit1.Text)));
DBEdit1.SelStart := Cursor;
end;
end;

 

کدی برای تشخیص صحت آدرس ایمیل
function IsEMail(EMail: String): Boolean;
var
s: String;
ETpos: Integer;
begin
ETpos:= pos('@', EMail);
if ETpos > 1 then
begin
s:= copy(EMail,ETpos+1,Length(EMail));
if (pos('.', s) > 1) and (pos('.', s) < length(s)) then
Result:= true else Result:= false;
end
else
Result:= false;
end;

//Utilizzo:
procedure TForm1.Button1Click(Sender: TObject);
begin
if isemail(Edit1.Text) then
begin
ShowMessage('Indirizzo e-mail valido!');
end;
end;

کدی برای ارسال ایمیل

uses ShellAPI;

procedure InviaEMail ( const Indirizzo, IndirizziCC, Oggetto, Testo: string);
var
Comando: String;
begin
Comando := 'mailto:' + Indirizzo + '?subject=' + Oggetto + '&cc=' + IndirizziCC + '&body=' + Testo;
if (ShellExecute(0, 'open', PChar(Comando), '', '', SW_SHOWNORMAL) <= 32)
then
ShowMessage('Errore nell''invio della e-mail.');
end;
//////////

procedure TForm1.Button1Click(Sender: TObject);
begin
InviaEMail ( '[e-mail]', '[e-mail]', 'Oggetto della e-mail', 'Testo della e-mail');
end;

کدی برای قراردادن کرسر در مختصات دلخواه در ریچ ادیت

procedure SetCursoreXY(tempRichEdit: TRichEdit; Colonna, Riga: Integer);
var
CharRange: TCharRange;
begin
CharRange.cpMin := tempRichEdit.Perform(EM_LINEINDEX, Riga, 0) + Colonna;
CharRange.cpMax := CharRange.cpMin;
tempRichEdit.Perform(EM_EXSETSEL, 0, LPARAM(@CharRange));
tempRichEdit.Perform(EM_SCROLLCARET, 0, 0);
tempRichEdit.SetFocus
end;

کدی برای از کار انداختن کلید های ۳ تایی یعنی alte+ctrl+del

procedure AttivaCtrlAltCanc;
var
VecchioValore : LongInt;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING, Word(False),@VecchioValore, 0);
end;

procedure ImpedisciCtrlAltCanc;
var
VecchioValore : LongInt;
begin
SystemParametersInfo(SPI_SCREENSAVERRUNNING, Word(True),@VecchioValore, 0);
end;

cassetto del CD-ROM
کدی برای تغییر ولوم درایو مورد نظر

function ImpostaNomeDisco( const Disco: Char; const Etichetta: String): Boolean;
begin
Result := SetVolumeLabel(PChar(Disco + ':\'), PChar(Etichetta));
end;
//////////////////////////

procedure TForm1.Button1Click(Sender: TObject);
begin
ImpostaNomeDisco('A', 'Prova')
end;

کدی برای اجکت cd rom

mciSendString('Set CDAudio Door Open', nil, 0, 0); // apre il cassetto del CD-ROM
...
mciSendString('Set CDAudio Door Closed', nil, 0, 0; // chiude il

کدی برای مقایسه دو تصویر بیت مپ

function compareBmp(Bmp1, Bmp2: TBitmap): Boolean;
var y,x: Integer;
     P1, P2: PByteArray;
begin
    Result := False;
    if Bmp1.WIdth <> Bmp2.Width then Exit;
    if Bmp1.Height <> Bmp2.Height then Exit;
    if Bmp1.PixelFormat <> Bmp2.PixelFormat then Exit;
    for y := 0 to Bmp1.Height - 1 do
    begin
        P1 := PByteArray(Bmp1.Scanline);
        P2 := PByteArray(Bmp2.Scanline);
        for x := 0 to Bmp1.Width -1 do
            if P1[x] <> P2[x] then Exit;
    end;
    Result := True;
end;

تابعی خفن برای گرفتن مشخصات فایل در ویندوز

procedure ShowFileProperties(const filename: String);
var
    sei: TShellExecuteinfo;
begin
    FillChar(sei,sizeof(sei),0);
    sei.cbSize := sizeof(sei);
    sei.lpFile := Pchar(filename);
    sei.lpVerb := 'properties';
    sei.fMask := SEE_MASK_INVOKEIDLIST;
    ShellExecuteEx(@sei);
end;

تابعی برای بدست آوردن میزان فضای خالی دیسک

function GetDiskFreeSpace(DriveLetter : String): Int64;
var
    sgDrive : String;
    pcDrive : PChar;
    chDrive : Char;
    inDrive : Int64;
begin
    sgDrive := Trim(DriveLetter);
    sgDrive := Copy(sgDrive,1,1);
    sgDrive := UpperCase(sgDrive);
    pcDrive := PChar(sgDrive);
    chDrive := pcDrive[0];
    inDrive := Ord(chDrive)-64;
    if inDrive < 0 Then inDrive := 0;
    Result := DiskFree(inDrive);
end;

پیدا کردن هندل برنامه های مختلف

var IconsHandle : THandle;

...

IconsHandle := FindWindow('Progman','Program Manager');
ShowWindow (IconsHandle,SW_HIDE);

تابعی برای تغییر وصوح صفحه نمایش

function ChangeRisol (PixelOriz,PixelVert,BitPixel : Integer) : Boolean;
var
    Dev : TDevMode;
    Chng : Integer;
begin
    Result:=False;
    Dev.dmSize:=SizeOf(Dev);
    Dev.dmPelsWidth:=PixelOriz;
    Dev.dmPelsHeight:=PixelVert;
    Dev.dmBitsPerPel:=BitPixel;
    Dev.dmDisplayFrequency:=60;
    Chng:=ChangeDisplaySettings(Dev,0);
    if (Chng=DISP_CHANGE_SUCCESSFUL) or (Chng=DISP_CHANGE_RESTART) Then
    Result:=True;
end;

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

var Registro : TRegistry;

begin
    Registro:=TRegistry.Create;
    try
        Registro.RootKey:=HKEY_LOCAL_MACHINE;
        Registro.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',False);
        if not Registro.ValueExists('NomeMiaApplicazione') then
            Registro.WriteString('NomeMiaApplicazione',(Application.ExeName));
    finally
        Registro.Free;
    end;
end;

اصافه کردن فایل به My recent

uses ShlOBJ;

var
    S : string;
begin
    S := 'C:\DownLoad\ntkfaq.html';
    SHAddToRecentDocs( SHARD_PATH, pChar(s) );
end;

به صدا در آوردن صدا های پیش فرض در ویندوز

PlaySound(pChar('SYSTEMSTART'),0,SND_ASYNC);

كدی برای تنظیمات صدای خروجی

Includere la unit MMSystem

WaveOutSetVolume(0, 00000000); // azzera il volume
WaveOutSetVolume(0, $FFFFFFFF); // imposta al massimo il volume

بازم سلام

کدی برای اینکه بفهمید برنامه تان چه مقدار از رم را گرفته است

function MemoriaRAMLibera: DWORD;
var
StatoMemoria: TMemoryStatus;
begin
StatoMemoria.dwLength := SizeOf (StatoMemoria);
GlobalMemoryStatus (StatoMemoria);
Result := StatoMemoria.dwAvailPhys;
end;

با عرض سلام خدمت تمامی کاربران محترم

به زودی در این وب لاگ آموزش اساسی وکاربردی دلفی داده می شود

از کلیه علاقمه مندان به دلفی و دلفی کاران دعوت به همکاری

می شود ونظرات خود را ابراز کنند تا تمهیدات لازم برای کاربران

و بازدید کنندگان پیش بینی شود

اولین کد ما

۱.یک برنامه کوچک همراه با سورس برای ارسال ایمیل که می تواند یکی از ابزارهای اضافی برای برنامه های شما باشد

۲.برنامه برای تماس با کامپیوتر از طریق تلفن و کامپوننت آن

۳.کامپوننتی برای کنترل پورت های کام

۴.کامپوننتی برای زیباسازی فرم و آبجکت های دیگر

۵.نکات و ترفند های خاص در دلفی که در هر هفته و طبق درخواست کاربران در وب قرار داده می شود

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

الکترونیک خودرا در نظرات خود بیان کنید و یک موضوع درخواستی از لیست بالا را انتخاب کنید تا برای شما ارسال شود

با تشکر