{******************************************************************} { Main.pas } { } { Author : A.Nasir Senturk } { Home Page : http://www.shenturk.com } { Email : shenturk@gmail.com } { } { Date : 11.12.2006 } { Update : 27.03.2007 } { } { Sizden iki şey rica edicem: } { 1. Lutfen bu baslik kismini kaldirmayiniz. } { 2. Mumkunse bagis yapiniz. } { *****************************************************************} // Timer eventleri nil yapmayi unutma!!! unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, GdipApi, GdipObj, DirectDraw, StdCtrls, ExtCtrls, TextUtil, ConstDef, TrayUtil, Menus, IniFiles, WinInet, XPMan, SyncObjs, ActnList, DateUtils, AboutDlg, OptnsDlg, Unicode, InetThrd, TraffDlg, NtfyDlg, ModiLess, DtlsDlg, MsHtml7, HtmlPrsr, AdslPrsr, GdipComp, MMSystem; type TEyMainForm = class(TForm) BackgrndLbl: TLabel; TrayPopup: TPopupMenu; TrayExitMenu: TMenuItem; TrayHideMenu: TMenuItem; TrayShowMenu: TMenuItem; XPManifest1: TXPManifest; VersionTimer: TTimer; LoadedTimer: TTimer; ShortPopup: TPopupMenu; N1: TMenuItem; AboutMenu: TMenuItem; N3: TMenuItem; ExitMainMenu: TMenuItem; RefreshMenu: TMenuItem; OptionsMenu: TMenuItem; MainActionList: TActionList; ExitAction: TAction; OptionsAction: TAction; HideAction: TAction; ShowAction: TAction; RefreshAction: TAction; AboutAction: TAction; TrayOptionsMenu: TMenuItem; N5: TMenuItem; N6: TMenuItem; TrayAboutMenu: TMenuItem; TrayRefreshMenu: TMenuItem; N7: TMenuItem; CaptionLbl: TLabel; LeftSizeLbl: TLabel; ExitLbl: TLabel; HideLbl: TLabel; OptionsLbl: TLabel; UpLbl: TLabel; WebLinkLbl: TLabel; RefreshTimer: TTimer; DonateLbl: TLabel; HibernateAction: TAction; TrayHibernateMenu: TMenuItem; AlwaysTopAction: TAction; TrayAlwaysTopAction: TMenuItem; ShowTrafficAct: TAction; N8: TMenuItem; TrayNetMonMenu: TMenuItem; LeftSizeTitleLbl: TLabel; UpTitleLbl: TLabel; DownTitleLbl: TLabel; DownLbl: TLabel; DownPanel: TLabel; DownBarLbl: TLabel; PercentLbl: TLabel; DetailsPanel: TLabel; N9: TMenuItem; NetMonMenu: TMenuItem; ExcessTitleLbl: TLabel; ExcessLbl: TLabel; MouseTimer: TTimer; N2: TMenuItem; HibernateMenu: TMenuItem; HideMenu: TMenuItem; AlwaysTopMenu: TMenuItem; Countdown: TTimer; StarterTimer: TTimer; N4: TMenuItem; N10: TMenuItem; NormalViewAct: TAction; BriefViewAct: TAction; N11: TMenuItem; NormalViewMenu: TMenuItem; BriefViewMenu: TMenuItem; CancelRefreshAct: TAction; CancelRefreshMenu: TMenuItem; StatusTextLbl: TLabel; N12: TMenuItem; TrayNormalViewMenu: TMenuItem; TrayBriefViewMenu: TMenuItem; TrayCancelRefreshMenu: TMenuItem; StatusTimer: TTimer; ShowDetailsAct: TAction; ShowDetailsMenu: TMenuItem; TrayShowDetailsMenu: TMenuItem; PayTitleLbl: TLabel; PayLabel: TLabel; RunWizardAct: TAction; RunWizardAct1: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure LoadedTimerTimer(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure ExitActionExecute(Sender: TObject); procedure OptionsActionExecute(Sender: TObject); procedure HideActionExecute(Sender: TObject); procedure ShowActionExecute(Sender: TObject); procedure RefreshActionExecute(Sender: TObject); procedure AboutActionExecute(Sender: TObject); procedure RefreshTimerTimer(Sender: TObject); procedure HibernateActionExecute(Sender: TObject); procedure AlwaysTopActionExecute(Sender: TObject); procedure ShowTrafficActExecute(Sender: TObject); procedure ExitLblMouseEnter(Sender: TObject); procedure ExitLblMouseLeave(Sender: TObject); procedure HideLblMouseEnter(Sender: TObject); procedure HideLblMouseLeave(Sender: TObject); procedure WebLinkLblMouseEnter(Sender: TObject); procedure WebLinkLblMouseLeave(Sender: TObject); procedure WebLinkLblClick(Sender: TObject); procedure MouseTimerTimer(Sender: TObject); procedure CountdownTimer(Sender: TObject); procedure StarterTimerTimer(Sender: TObject); procedure NormalViewActExecute(Sender: TObject); procedure BriefViewActExecute(Sender: TObject); procedure CancelRefreshActExecute(Sender: TObject); procedure StatusTimerTimer(Sender: TObject); procedure ShowDetailsActExecute(Sender: TObject); procedure DonateLblMouseEnter(Sender: TObject); procedure DonateLblMouseLeave(Sender: TObject); procedure DonateLblClick(Sender: TObject); procedure RunWizardActExecute(Sender: TObject); procedure VersionTimerTimer(Sender: TObject); private { Private declarations } Updating: Boolean; Moving: Boolean; OpacityMin, OpacityMax, Opacity: Byte; MainBuffer: TGPBitmap; DrawCanvas: TGPGraphics; ColorizedImage, OverlayImage: TGPBitmap; TrayIcon: TTrayIcon; ShowTrayIcon: Boolean; PrevFormStyle: Cardinal; DownLinePen: TGPPen; BackFillBrush: TGPSolidBrush; BarFillBrush, DownBarBrush: TGPSolidBrush; CloseImage, CloseImageEnter, CloseImageLeave: TGPBitmap; HideImage, HideImageEnter, HideImageLeave: TGPBitmap; OptImage, OptImageEnter, OptImageLeave: TGPBitmap; WebLinkColor: Cardinal; DonateColor: Cardinal; AutoUpdate: Boolean; UpdatePeriod: Cardinal; // From LoginForm SessionCookie: string; SetCookie: string; UserName: string; Password: string; UserCanceled: Boolean; Thread: TInetThread; TimeLeft: Integer; TryPeriod: Integer; TryCount: Integer; MaxTry: Integer; UseWidgetEntry: Boolean; UseOCR: Boolean; RecognizedText: WideString; QuotaInfoText: WideString; ImageName: string; ModiLessForm: TModiLessForm; Busy: Boolean; SecureImage: TGPBitmap; // procedure AllocateDrawItems; procedure ReleaseDrawItems; procedure AllocateHandle; procedure ReleaseHandle; procedure SetFormStyleEx; protected procedure CMRestore(var Message: TMessage); message CM_RESTORE; procedure WMInetDone(var Message: TMessage); message WM_INETDONE; procedure WMIPAddrDone(var Message: TMessage); message WM_IPADDRDONE; procedure WMVersionDone(var Message: TMessage); message WM_VERSIONDONE; procedure WMMove(var Message: TWMMove); message WM_MOVE; procedure WMQueryEndSession(var Message: TWMQueryEndSession); message WM_QUERYENDSESSION; procedure WMEndSession(var Message: TWMEndSession); message WM_ENDSESSION; procedure MMMciNotify(var Message: TMessage); message MM_MCINOTIFY; // From LoginForm procedure WMLoginPageDone(var Message: TMessage); message WM_LOGINPAGEDONE; procedure WMSecureImgDone(var Message: TMessage); message WM_SECUREIMGDONE; procedure WMPostFormDone(var Message: TMessage); message WM_POSTFORMDONE; procedure WMAgreementDone(var Message: TMessage); message WM_AGREEMENTDONE; procedure WMGetQuotaDone(var Message: TMessage); message WM_GETQUOTADONE; procedure WMLogoutDone(var Message: TMessage); message WM_LOGOUTDONE; procedure ParseSetCookie; procedure GetInetLoginPageThread; procedure GetInetSecureImageThread; procedure PostInternetFormThread; procedure ConfirmAgreementThread; procedure GetQuotaInformationsThread; procedure DoLogoutServerThread; function ValidateQuotaInfo: Integer; procedure TryOverflowError; procedure InvalidUserError; procedure InvalidPasswordError; procedure SetStatusTextState(const StateCode: Integer); procedure EnableCountdownTimer(Enable: Boolean); procedure LoadSecureImage(const FileName: string); procedure ReleaseSecureImage; function GetRecognizedText: Integer; procedure SetStatusText(const Text: WideString); procedure ResetCountdown; procedure InitLoginForm; procedure DoneLoginForm; function Recognize(const FileName: string; var RecgText: WideString): Integer; function UseEntry(const FileName: string; var RecgText: WideString): Integer; function UseTesseract(const FileName: string; var RecgText: WideString): Integer; function GetUserInfo(var AUserName, APassword: string): Boolean; function GetStatusText(const StatusCode: Integer): WideString; procedure StartLogin(StartVisible: Boolean); procedure EnableStarterTimer(Enable: Boolean); procedure CancelLogin; function CheckLoginError: Integer; public IsActive: Boolean; EnableFadeEffect, StayOnTop, FirstUsage, UpdateStartup, ShowNetMonitor: Boolean; SizeLabelColor: Cardinal; BackColor: Cardinal; BackOpacity: Byte; DownloadAsByte: Double; DownFormat: TFormatType; UploadAsByte: Double; UpFormat: TFormatType; QuotaAsByte: Double; QuotaFormat: TFormatType; LeftAsByte: Double; LeftFormat: TFormatType; ExcessAsByte: Double; ExcessFormat: TFormatType; MaxPayRef: Double; PayPercent: Double; DefaultFormat: Boolean; PeriodStr: WideString; MonthStr: WideString; YearStr: string; RecordTimeStr: string; DisplayName: WideString; HtmlUserName: WideString; ServiceNoStr: string; InetHandle: HINTERNET; InetSuccess: Boolean; IPAddrThread: TInetThread; IPAddressXML: WideString; IPAddressStr: string; VersionThread: TInetThread; VersionXML: WideString; VersionStr: WideString; OptionsActive: Boolean; AboutForm: TAboutForm; TrafficForm: TTrafficForm; NotifierForm: TNotifierForm; DetailsForm: TDetailsForm; TrafficDist: TPoint; DetailsDist: TPoint; ViewStyle: TViewStyle; MonthlyPay, PayPerMB: Double; UseInteger: Boolean; AdslParser: TAdslParser; DataCount: Integer; NotifyMe: Boolean; NotifyType: TNotifyType; DeviceID: Word; AlertPercent: Integer; Alert: Boolean; HibernateAlert: Boolean; AlertShow: Boolean; TrafficWith, DetailsWith: Boolean; TextColor: TGPColor; BackFillColor: TGPColor; BackFillOpacity: Byte; { Public declarations } procedure UpdateLayered; procedure UpdateMainWindow; procedure DoActivate(Sender: TObject); procedure DoDeactivate(Sender: TObject); procedure PaintBackground; procedure PaintButtons; procedure LoadOptions; procedure SaveOptions; procedure SetWorkArea; procedure DisableEvents; procedure EnableEvents; procedure FadeInEffect(const Step, Wait, Max: Integer); procedure FadeOutEffect(const Step, Wait, Min: Integer); procedure HideMainForm; procedure ShowMainForm; procedure HideFormEffect(const Min: Integer); procedure ShowFormEffect(const Max: Integer); procedure Hibernate; procedure Wakeup; procedure UpdateActionsState; procedure ShowOptionsDialog(const PageIndex: Integer); procedure PaintCaption; function OpenInternet: Boolean; procedure CloseInternet; procedure FetchIPAddress; procedure ParseIPAddressXML; procedure CheckVersion; procedure ParseVersionXML; procedure UpdateAdslInfo; function GetTestText: WideString; function GetTrayHintText: WideString; procedure UpdateTrayHintText; procedure PaintDownPanel; procedure PaintDownTitle; procedure PaintDownload; procedure PaintDownBar; procedure PaintPercent; function GetPeriodText: WideString; procedure PaintCloseButton; procedure PaintHideButton; procedure PaintOptionsButton; procedure PaintDetailsPanel; procedure PaintUpTitle; procedure PaintUpload; procedure PaintLeftSizeTitle; procedure PaintLeftSize; function GetLeftSize: Double; function GetLeftAsString: string; function GetDownloadAsString: string; function GetUpLoadAsString: string; function GetQuotaAsString: string; function GetExcessAsString: WideString; function GetPercentAsString: WideString; procedure PaintWebLink; procedure PaintStatusText; procedure PaintDonateLabel; function GetExcessSize: Double; procedure PaintExcessTitle; procedure PaintExcessSize; procedure ShowOverflowMessage; procedure ShowNotChangeMessage; procedure ShowNotChangeForm; procedure PlayNotChangeSound; procedure ShowInfoMessage; procedure ShowInfoForm; procedure PlayInfoSound; procedure ShowInvalidUserMessage; procedure ShowInvalidPassMessage; procedure SetNormalViewStyle; procedure SetBriefViewStyle; procedure SetViewStyle(const AViewStyle: TViewStyle); function BytesToString(Value : Double) : string; function ConvertTo(const Value: Double; FormatType: TFormatType): string; function ConvertToByte(const Value: Double): string; function ConvertToKiloByte(const Value: Double): string; function ConvertToMegaByte(const Value: Double): string; function ConvertToGigaByte(const Value: Double): string; procedure PaintPayTitle; procedure PaintPay; function GetPayText: WideString; procedure MciClose; procedure MciPlayFile(const WaveName: string); function CheckAlertPercent: Boolean; procedure CheckHibernateAlert; procedure StartupFirstUsage; procedure StartupNormal; procedure ShowTaskbarButton(CmdShow: Boolean); procedure SetColorsDrawItems; end; var EyMainForm: TEyMainForm; implementation uses Math, ActiveX, ComObj, ShelApix, GdipUtil, GnuOcr, PswdDlg, HbrntDlg, EyWizard; {$R *.dfm} procedure TEyMainForm.AllocateHandle; begin MainBuffer := TGPBitmap.Create(Width, Height, PixelFormat32bppARGB); DrawCanvas := TGPGraphics.Create(MainBuffer); end; procedure TEyMainForm.FormCreate(Sender: TObject); begin HibernateMenu.Caption := strHibernateMenu; AlertShow := False; DeviceID := 0; AdslParser := TAdslParser.Create(Self); UseWidgetEntry := True; WebLinkColor := $8FFFFFFF; DonateColor := $8FFFFFFF; InetSuccess := OpenInternet; ColorizedImage := TGPBitmap.Create(UIPath + Background6Image); OverlayImage := TGPBitmap.Create(UIPath + Overlay6Image); CloseImageEnter := TGPBitmap.Create(UIPath + CloseEnterImage); CloseImageLeave := TGPBitmap.Create(UIPath + CloseLeaveImage); CloseImage := CloseImageLeave; HideImageEnter := TGPBitmap.Create(UIPath + HideEnterImage); HideImageLeave := TGPBitmap.Create(UIPath + HideLeaveImage); HideImage := HideImageLeave; OptImageEnter := TGPBitmap.Create(UIPath + OptEnterImage); OptImageLeave := TGPBitmap.Create(UIPath + OptLeaveImage); OptImage := OptImageLeave; Self.Left := IniFile.ReadInteger(sGeneral, sLeft, 444); Self.Top := IniFile.ReadInteger(sGeneral, sTop, 177); Self.Width := ColorizedImage.GetWidth; Self.Height := ColorizedImage.GetHeight; TrayIcon := TTrayIcon.Create(Self); TrayIcon.Visible := False; TrayIcon.Hint := 'Ey DSL! çalışıyor.'; TrayIcon.Icon := Application.Icon; TrayIcon.PopupMenu := TrayPopup; TrayIcon.OnDblClick := ShowActionExecute; TrayIcon.BalloonTitle := 'Ey DSL!'; TrayIcon.BalloonFlags := bfInfo; TrayIcon.BalloonHint := sBalloonHintMsg; VersionTimer.Enabled := IniFile.ReadBool(sGeneral, sCheckNewVersion, True); Application.OnActivate := EyMainForm.DoActivate; Application.OnDeactivate := EyMainForm.DoDeactivate; SetFormStyleEx; AllocateDrawItems; LoadOptions; OpacityMin := DefOpacityMin; OpacityMax := DefOpacityMax; if EnableFadeEffect then Opacity := DefOpacityMin else Opacity := DefOpacityMax; UpdateLayered; RefreshTimer.Enabled := AutoUpdate; RefreshTimer.Interval := UpdatePeriod; AboutForm := TAboutForm.Create(Self); TrafficForm := TTrafficForm.Create(Self); DetailsForm := TDetailsForm.Create(Self); NotifierForm := TNotifierForm.Create(Self); LoadedTimer.Enabled := True; end; procedure TEyMainForm.ReleaseHandle; begin if Assigned(MainBuffer) then FreeAndNil(MainBuffer); if Assigned(DrawCanvas) then FreeAndNil(DrawCanvas); end; procedure TEyMainForm.UpdateLayered; begin Updating := True; try ReleaseHandle; AllocateHandle; UpdateActionsState; PaintBackground; PaintButtons; PaintCaption; PaintDownPanel; PaintDetailsPanel; PaintStatusText; PaintWebLink; PaintDonateLabel; UpdateMainWindow; finally Updating := False; end; end; procedure TEyMainForm.FormDestroy(Sender: TObject); begin StatusTimer.OnTimer := nil; MouseTimer.OnTimer := nil; RefreshTimer.OnTimer := nil; LoadedTimer.OnTimer := nil; VersionTimer.OnTimer := nil; StarterTimer.OnTimer := nil; Countdown.OnTimer := nil; if Assigned(Thread) then FreeAndNil(Thread); if Assigned(ModiLessForm) then ModiLessForm.Free; ReleaseSecureImage; ReleaseDrawItems; OptImageEnter.Free; OptImageLeave.Free; HideImageEnter.Free; HideImageLeave.Free; CloseImageEnter.Free; CloseImageLeave.Free; OverlayImage.Free; ColorizedImage.Free; DetailsForm.Free; TrafficForm.Free; AboutForm.Free; NotifierForm.Free; ReleaseHandle; TrayIcon.Free; CloseInternet; SaveOptions; end; procedure TEyMainForm.UpdateMainWindow; var ScrDC, MemDC: HDC; BitmapHandle, PrevBitmap: HBITMAP; BlendFunc: _BLENDFUNCTION; Size: TSize; P, S: TPoint; begin ScrDC := CreateCompatibleDC(0); MemDC := CreateCompatibleDC(ScrDC); MainBuffer.GetHBITMAP(0, BitmapHandle); PrevBitmap := SelectObject(MemDC, BitmapHandle); Size.cx := Width; Size.cy := Height; P := Point(Left, Top); S := Point(0, 0); with BlendFunc do begin BlendOp := AC_SRC_OVER; BlendFlags := 0; SourceConstantAlpha := Opacity; AlphaFormat := AC_SRC_ALPHA; end; UpdateLayeredWindow(Handle, ScrDC, @P, @Size, MemDC, @S, 0, @BlendFunc, ULW_ALPHA); SelectObject(MemDC, PrevBitmap); DeleteObject(BitmapHandle); DeleteDC(MemDC); DeleteDC(ScrDC); end; procedure TEyMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var R: TRect; begin if (Button = mbLeft) and (ssShift in Shift) then begin HibernateActionExecute(Self); Exit; end; if Assigned(TrafficForm) then begin TrafficDist.X := TrafficForm.Left - Self.Left; TrafficDist.Y := TrafficForm.Top - Self.Top; end; if Assigned(DetailsForm) then begin DetailsDist.X := DetailsForm.Left - Self.Left; DetailsDist.Y := DetailsForm.Top - Self.Top; end; if Button = mbLeft then begin Moving := True; ReleaseCapture; SendMessage( Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0 ); GetWindowRect(Handle, R); Left := R.Left; Top := R.Top; Moving := False; UpdateLayered; end; end; procedure TEyMainForm.DoActivate(Sender: TObject); begin IsActive := True; //CaptionLbl.Caption := 'Activate'; UpdateLayered; end; procedure TEyMainForm.DoDeactivate(Sender: TObject); begin IsActive := False; //CaptionLbl.Caption := 'Deactivate'; UpdateLayered; end; procedure TEyMainForm.PaintBackground; procedure PaintColorizedOverlay; begin DrawCanvas.DrawImage(OverlayImage, BackgrndLbl.Left + 6, BackgrndLbl.Top + 3, OverlayImage.GetWidth, OverlayImage.GetHeight); end; procedure PaintColorized(Color: Cardinal; Alpha: Byte); const CMatrix: ColorMatrix = ( (1.0, 0.0, 0.0, 0.0, 1.0), (0.0, 1.0, 0.0, 0.0, 0.0), (0.0, 0.0, 1.0, 0.0, 0.0), (0.0, 0.0, 0.0, 1.0, 0.0), (0.0, 0.0, 0.0, 0.0, 1.0) ); var Attr: TGPImageAttributes; Matrix: ColorMatrix; begin Matrix := CMatrix; Matrix[3, 3] := (Alpha / 255); Matrix[0, 0] := 2 * (GetRValue(Color) / 255); Matrix[1, 1] := 2 * (GetGValue(Color) / 255); Matrix[2, 2] := 2 * (GetBValue(Color) / 255); Attr := TGPImageAttributes.Create; try Attr.SetColorMatrix(Matrix, ColorMatrixFlagsDefault, ColorAdjustTypeBitmap); DrawCanvas.DrawImage(ColorizedImage, MakeRect(BackgrndLbl.Left, BackgrndLbl.Top, ColorizedImage.GetWidth, ColorizedImage.GetHeight), // dest rect 0, 0, ColorizedImage.GetWidth, ColorizedImage.GetHeight, // source rect UnitPixel, Attr); PaintColorizedOverlay; finally Attr.Free; end; end; begin if BackgrndLbl.Visible then PaintColorized(BackColor, BackOpacity); end; procedure TEyMainForm.CMRestore(var Message: TMessage); begin Application.Restore; if not Self.Visible then begin ShowMainForm; end; end; procedure TEyMainForm.LoadOptions; begin SetWorkArea; ShowTaskbarButton(IniFile.ReadBool(sGeneral, sShowTaskbar, True)); DefaultFormat := IniFile.ReadBool(sGeneral, sDefaultFormat, True); DownFormat := TFormatType(IniFile.ReadInteger(sGeneral, sDownFormat, 0)); UpFormat := TFormatType(IniFile.ReadInteger(sGeneral, sUpFormat, 0)); QuotaFormat := TFormatType(IniFile.ReadInteger(sGeneral, sQuotaFormat, 0)); LeftFormat := TFormatType(IniFile.ReadInteger(sGeneral, sLeftFormat, 0)); ExcessFormat := TFormatType(IniFile.ReadInteger(sGeneral, sExcessFormat, 0)); DisplayName := IniFile.ReadString(sGeneral, sDisplayName, ''); DataCount := IniFile.ReadInteger(sGeneral, sDataCount, 0); BackColor := IniFile.ReadInteger(sGeneral, sBackColor, Integer($00C08000)); BackOpacity := IniFile.ReadInteger(sGeneral, sBackOpacity, Integer($E0)); TextColor := IniFile.ReadInteger(sGeneral, sTextColor, Integer($00FFFFFF)); BackFillColor := IniFile.ReadInteger(sGeneral, sBackFillColor, Integer($00000000)); BackFillOpacity := IniFile.ReadInteger(sGeneral, sBackFillOpacity, Integer($80)); SetColorsDrawItems; DownloadAsByte := IniFile.ReadFloat(sGeneral, sDownload, 0.00); UploadAsByte := IniFile.ReadFloat(sGeneral, sUpload, 0.00); QuotaAsByte := IniFile.ReadFloat(sGeneral, sQuota, 4.00 * GigaByte); if QuotaAsByte <= 0 then QuotaAsByte := 4.00 * GigaByte; ExcessAsByte := GetExcessSize(); MaxPayRef := IniFile.ReadFloat(sGeneral, sMaxPayRef, 99.00); PayPercent := IniFile.ReadFloat(sGeneral, sPayPercent, 25.00); MonthStr := IniFile.ReadString(sGeneral, sMonth, ''); YearStr := IniFile.ReadString(sGeneral, sYear, ''); RecordTimeStr := IniFile.ReadString(sGeneral, sRecordTime, ''); ServiceNoStr := IniFile.ReadString(sGeneral, sServiceNo, ''); AutoUpdate := IniFile.ReadBool(sGeneral, sAutoUpdate, True); EnableFadeEffect := IniFile.ReadBool(sGeneral, sFadeEffect, True); case IniFile.ReadInteger(sGeneral, sUpdatePeriod, 2) of 1: UpdatePeriod := 45 * MinuteMs; 2: UpdatePeriod := HourMs; 3: UpdatePeriod := 90 * MinuteMs; 4: UpdatePeriod := 2 * HourMs; 5: UpdatePeriod := 3 * HourMs; 6: UpdatePeriod := 4 * HourMs; 7: UpdatePeriod := 5 * HourMs; 8: UpdatePeriod := 6 * HourMs; 9: UpdatePeriod := 9 * HourMs; 10: UpdatePeriod := 12 * HourMs; else UpdatePeriod := 30 * MinuteMs; //UpdatePeriod := 10 * 1000; end; RefreshTimer.Interval := UpdatePeriod; ShowTrayIcon := IniFile.ReadBool(sGeneral, sShowTrayIcon, True); FirstUsage := IniFile.ReadBool(sGeneral, sFirstUsage, True); TrayIcon.Visible := ShowTrayIcon and (not FirstUsage); UpdateStartup := IniFile.ReadBool(sGeneral, sUpdateStartup, True); ShowNetMonitor := IniFile.ReadBool(sNetworkMonitor, sEnable, True); StayOnTop := IniFile.ReadBool(sGeneral, sAlwaysTop, False); TryPeriod := IniFile.ReadInteger(sGeneral, sTryPeriod, 3); if (TryPeriod <= 0) or (TryPeriod > 60) then TryPeriod := 3; TimeLeft := TryPeriod; MaxTry := IniFile.ReadInteger(sGeneral, sMaxTry, 9); if (MaxTry <= 0) or (MaxTry > 19) then MaxTry := 9; TryCount := 1; UseOCR := IniFile.ReadBool(sGeneral, sUseOCR, True); ViewStyle := TViewStyle(IniFile.ReadInteger(sGeneral, sViewStyle, Integer(vsNormal))); MonthlyPay := IniFile.ReadFloat(sGeneral, sMonthlyPay, 29.00); PayPerMB := IniFile.ReadFloat(sGeneral, sPayPerMB, 0.01); UseInteger := IniFile.ReadBool(sGeneral, sUseInteger, True); NotifyMe := IniFile.ReadBool(sGeneral, sNotify, True); NotifyType := TNotifyType(IniFile.ReadInteger(sGeneral, sNotifyType, Integer(ntBoth))); AlertPercent := IniFile.ReadInteger(sGeneral, sAlertPercent, 90); Alert := IniFile.ReadBool(sGeneral, sAlert, True); TrafficWith := IniFile.ReadBool(sNetworkMonitor, sMoveWith, True); DetailsWith := IniFile.ReadBool(sDetails, sMoveWith, True); UpdateTrayHintText(); end; procedure TEyMainForm.SaveOptions; begin IniFile.WriteInteger(sGeneral, sLeft, Left); IniFile.WriteInteger(sGeneral, sTop, Top); IniFile.WriteFloat(sGeneral, sDownload, DownloadAsByte); IniFile.WriteFloat(sGeneral, sUpload, UploadAsByte); IniFile.WriteString(sGeneral, sMonth, MonthStr); IniFile.WriteString(sGeneral, sYear, YearStr); IniFile.WriteString(sGeneral, sRecordTime, RecordTimeStr); IniFile.WriteString(sGeneral, sServiceNo, ServiceNoStr); IniFile.WriteInteger(sGeneral, sTryPeriod, TryPeriod); IniFile.WriteInteger(sGeneral, sMaxTry, MaxTry); if FirstUsage then FirstUsage := False; IniFile.WriteBool(sGeneral, sFirstUsage, False); IniFile.UpdateFile; end; procedure TEyMainForm.DisableEvents; begin RefreshTimer.Enabled := False; RefreshAction.Enabled := False; StatusTimer.Enabled := False; CancelRefreshAct.Enabled := True; end; procedure TEyMainForm.EnableEvents; begin RefreshTimer.Enabled := AutoUpdate; RefreshAction.Enabled := True; StatusTimer.Enabled := True; CancelRefreshAct.Enabled := False; end; procedure TEyMainForm.LoadedTimerTimer(Sender: TObject); begin LoadedTimer.Enabled := False; if FirstUsage then StartupFirstUsage else StartupNormal; end; procedure TEyMainForm.FadeInEffect(const Step, Wait, Max: Integer); begin if not EnableFadeEffect then Exit; while Opacity < Max do begin Application.ProcessMessages; if Opacity + Step >= Max then begin Opacity := Max; UpdateMainWindow; Break; end; Opacity := Opacity + Step; UpdateMainWindow; Sleep(Wait); end; end; procedure TEyMainForm.FadeOutEffect(const Step, Wait, Min: Integer); begin if not EnableFadeEffect then Exit; while Opacity > Min do begin Application.ProcessMessages; if Opacity - Step <= Min then begin Opacity := Min; UpdateMainWindow; Break; end; Opacity := Opacity - Step; UpdateMainWindow; Sleep(Wait); end; end; procedure TEyMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin SaveOptions; NotifierForm.HideForm; DetailsForm.HideForm; TrafficForm.HideForm; HideMainForm; end; procedure TEyMainForm.HideMainForm; begin HideFormEffect(OpacityMin); Self.Hide; end; procedure TEyMainForm.ShowMainForm; begin Self.Show; ShowFormEffect(OpacityMax); end; procedure TEyMainForm.PaintButtons; begin PaintCloseButton; PaintHideButton; PaintOptionsButton; end; procedure TEyMainForm.WMMove(var Message: TWMMove); begin inherited; if TrafficWith and Assigned(TrafficForm) then begin TrafficForm.Left := Self.Left + TrafficDist.X; TrafficForm.Top := Self.Top + TrafficDist.Y; end; if DetailsWith and Assigned(DetailsForm) then begin DetailsForm.Left := Self.Left + DetailsDist.X; DetailsForm.Top := Self.Top + DetailsDist.Y; end; end; procedure TEyMainForm.ExitActionExecute(Sender: TObject); begin Close; end; procedure TEyMainForm.OptionsActionExecute(Sender: TObject); begin ShowOptionsDialog(-1); end; procedure TEyMainForm.HideActionExecute(Sender: TObject); begin HideMainForm; end; procedure TEyMainForm.ShowActionExecute(Sender: TObject); begin SetForegroundWindow( Self.Handle); ShowMainForm; end; procedure TEyMainForm.RefreshActionExecute(Sender: TObject); begin RefreshTimerTimer(Self); end; procedure TEyMainForm.AboutActionExecute(Sender: TObject); begin AboutForm.ShowForm; end; procedure TEyMainForm.UpdateActionsState; begin end; procedure TEyMainForm.ShowOptionsDialog(const PageIndex: Integer); var Options: TOptionsForm; begin if OptionsActive then Exit; Options := TOptionsForm.Create(Self); try OptionsActive := True; SaveOptions; if (PageIndex >= 0) and (PageIndex < Options.PageControl1.PageCount) then Options.PageControl1.ActivePageIndex := PageIndex; if Options.ShowModal = mrOk then begin LoadOptions; UpdateLayered; DetailsForm.UpdateDetails; if Options.AdapterChanged then TrafficForm.ChangeAdapter; TrafficForm.LoadOptionsInterrupt; if Options.UserChanged then RefreshTimerTimer(Self); end else begin LoadOptions; UpdateLayered; DetailsForm.UpdateDetails; TrafficForm.LoadOptionsInterrupt; end; finally OptionsActive := False; Options.Free; end; end; procedure TEyMainForm.PaintCaption; begin if CaptionLbl.Visible then begin //CaptionLbl.Caption := 'Ey DSL!'; PaintLabelTo(DrawCanvas, CaptionLbl, CaptionLbl.Caption, StringAlignmentNear, $FFFFFFFF, True, TextRenderingHintAntiAlias); end; end; procedure TEyMainForm.RefreshTimerTimer(Sender: TObject); begin if not Busy then begin FetchIPAddress; InitLoginForm; StartLogin(True); UpdateLayered; end; end; procedure TEyMainForm.WMInetDone(var Message: TMessage); var Status: Integer; begin Status := Message.LParam; case Status of scSuccess : UpdateAdslInfo; scTryOverflow : ShowOverflowMessage; scInvalidUser : ShowInvalidUserMessage; scInvalidPass : ShowInvalidPassMessage; end; end; procedure TEyMainForm.Hibernate; begin OpacityMax := DefOpacityMax div 2; //188;// HideFormEffect(OpacityMax); end; procedure TEyMainForm.Wakeup; begin OpacityMax := DefOpacityMax; ShowFormEffect(OpacityMax); end; procedure TEyMainForm.HideFormEffect(const Min: Integer); begin if EnableFadeEffect then FadeOutEffect(DefOpacityStep, DefOpacityWait, Min) else begin Opacity := Min; UpdateMainWindow; end; end; procedure TEyMainForm.ShowFormEffect(const Max: Integer); begin if EnableFadeEffect then FadeInEffect(DefOpacityStep, DefOpacityWait, Max) else begin Opacity := Max; UpdateMainWindow; end; end; procedure TEyMainForm.WMIPAddrDone(var Message: TMessage); var Stream: TStringStream; begin IPAddressXML := ''; if Message.LParam = 0 then begin Stream := TStringStream.Create(''); try with IPAddrThread.Request.Response do begin ContentStream.SaveToStream(Stream); IPAddressXML := Stream.DataString; end; finally Stream.Free; end; ParseIPAddressXML; end; if Assigned(IPAddrThread) then FreeAndNil(IPAddrThread); if not Busy then SetStatusText(WideFormat('IP Adresim: %s', [IPAddressStr])); UpdateLayered; end; procedure TEyMainForm.FetchIPAddress; begin if Assigned(IPAddrThread) then begin if not IPAddrThread.Terminated then Exit; end; if Assigned(IPAddrThread) then FreeAndNil(IPAddrThread); IPAddressStr := 'Araştırılıyor...'; IPAddressXML := ''; IPAddrThread := TInetThread.Create(Self.Handle, WM_IPADDRDONE, InetHandle); try with IPAddrThread.Request do begin Host := ShowIPorgURL; URL := '/xml.aspx'; end; IPAddrThread.Resume; except FreeAndNil(IPAddrThread); end; UpdateLayered; end; procedure TEyMainForm.CloseInternet; begin if InetHandle <> nil then if InternetCloseHandle(InetHandle) then InetHandle := nil; end; function TEyMainForm.OpenInternet: Boolean; begin CloseInternet; InetHandle := InternetOpen('FreeDelphi Explorer', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); Result := InetHandle <> nil; end; procedure TEyMainForm.ParseIPAddressXML; var xmlPage, Elem: OleVariant; begin // showip.org sitesinde xml datanin basinda anlamini bilmedigim 3 karakter var. IPAddressXML := System.Copy(IPAddressXML, Pos(' 0 then begin MouseTimer.Enabled := False; Wakeup; SetWindowLong(Self.Handle, GWL_EXSTYLE, PrevFormStyle); end; end; procedure TEyMainForm.AlwaysTopActionExecute(Sender: TObject); var Style: Cardinal; begin AlwaysTopAction.Checked := not AlwaysTopAction.Checked; if AlwaysTopAction.Checked then Style := HWND_TOPMOST //HWND_TOP or else Style := HWND_NOTOPMOST; { SetWindowPos(Application.Handle, Style, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED); } SetWindowPos(Self.Handle, Style, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED); end; procedure TEyMainForm.ShowTrafficActExecute(Sender: TObject); begin ShowTrafficAct.Checked := not ShowTrafficAct.Checked; if ShowTrafficAct.Checked then TrafficForm.ShowForm else TrafficForm.HideForm; end; procedure TEyMainForm.SetFormStyleEx; var StyleEx: Cardinal; begin StyleEx := GetWindowLong(Handle, GWL_EXSTYLE); if StyleEx and WS_EX_LAYERED = 0 then SetWindowLong(Handle, GWL_EXSTYLE, StyleEx or WS_EX_LAYERED); end; procedure TEyMainForm.PaintDownPanel; begin if DownPanel.Visible then begin { DrawCanvas.DrawImage(ColorizedImage, MakeRect(DownPanel.Left, DownPanel.Top, DownPanel.Width, DownPanel.Height), // dest rect 0, 0, ColorizedImage.GetWidth, ColorizedImage.GetHeight, // source rect UnitPixel); } DrawCanvas.FillRectangle(BackFillBrush, MakeRect(DownPanel.BoundsRect)); DrawCanvas.DrawRectangle(DownLinePen, MakeRect(DownPanel.BoundsRect)); PaintDownTitle; PaintDownload; PaintDownBar; PaintPercent; end; end; procedure TEyMainForm.AllocateDrawItems; begin DownLinePen := TGPPen.Create($DC808080); BackFillBrush := TGPSolidBrush.Create(MakeColor(BackFillOpacity, GetRValue(BackFillColor), GetGValue(BackFillColor), GetBValue(BackFillColor))); BarFillBrush := TGPSolidBrush.Create($80FFFFFF); DownBarBrush := TGPSolidBrush.Create($DC00FF00); end; procedure TEyMainForm.ReleaseDrawItems; begin if Assigned(DownBarBrush) then FreeAndNil(DownBarBrush); if Assigned(BarFillBrush) then FreeAndNil(BarFillBrush); if Assigned(DownLinePen) then FreeAndNil(DownLinePen); if Assigned(BackFillBrush) then FreeAndNil(BackFillBrush); end; procedure TEyMainForm.PaintDownTitle; var R: TRect; AnyText: WideString; begin if DownTitleLbl.Visible then begin AnyText := GetPeriodText; DownTitleLbl.Caption := ' ' + AnyText + ' '; PaintLabelTo(DrawCanvas, DownTitleLbl, DownTitleLbl.Caption, StringAlignmentCenter, $00FFFFFF, True, TextRenderingHintAntiAliasGridFit); R := DownTitleLbl.BoundsRect; OffsetRect(R, 0, -1); DrawCanvas.FillRectangle(BackFillBrush, MakeRect(R)); PaintLabelTo(DrawCanvas, DownTitleLbl, DownTitleLbl.Caption, StringAlignmentCenter, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); DrawCanvas.DrawRectangle(DownLinePen, MakeRect(R)); end; end; procedure TEyMainForm.PaintDownBar; const BarCount = 40; var X, Y, W, H: Integer; Percent, Index: Integer; Colorize: Cardinal; RealPercent: Double; begin if not DownBarLbl.ShowHint then DownBarLbl.ShowHint := True; W := 2; H := 10; X := DownBarLbl.Left + 1; Y := DownBarLbl.Top + (DownBarLbl.Height - H) div 2 + 1; Index := 0; if QuotaAsByte <> 0 then begin RealPercent := DownloadAsByte / QuotaAsByte; Percent := Round(BarCount * (RealPercent)); end else begin RealPercent := 0.00; Percent := 0; end; Percent := Math.Min(Percent, BarCount); DownBarLbl.Hint := FormatFloat('%#,##0.00', RealPercent * 100); while Index < BarCount do begin if Index >= Percent then DrawCanvas.FillRectangle(BarFillBrush, MakeRect(X, Y, W, H)) else begin Colorize := MakeColor($FF, $FF, $FF - (($FF div BarCount) * Index), 0); DownBarBrush.SetColor(Colorize); DrawCanvas.FillRectangle(DownBarBrush, MakeRect(X, Y, W, H)); end; Inc(X, W + 1); Inc(Index); end; end; procedure TEyMainForm.PaintDownload; begin if DownLbl.Visible then begin DownLbl.Caption := 'Download: ' + GetDownloadAsString(); PaintLabelTo(DrawCanvas, DownLbl, DownLbl.Caption, StringAlignmentCenter, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; function TEyMainForm.GetPeriodText: WideString; begin if (MonthStr <> '') and (YearStr <> '') then Result := WideFormat('%s, %s Dönemi', [YearStr, MonthStr]) else Result := 'Bilinmiyor'; end; procedure TEyMainForm.PaintCloseButton; begin if ExitLbl.Visible then begin if Assigned(CloseImage) then DrawImageTo(DrawCanvas, ExitLbl.Left, ExitLbl.Top, CloseImage.GetWidth, CloseImage.GetHeight, CloseImage); end; end; procedure TEyMainForm.PaintHideButton; begin if HideLbl.Visible then begin if Assigned(HideImage) then DrawImageTo(DrawCanvas, HideLbl.Left, HideLbl.Top, HideImage.GetWidth, HideImage.GetHeight, HideImage); end; end; procedure TEyMainForm.PaintOptionsButton; begin if OptionsLbl.Visible then begin if Assigned(OptImage) then DrawImageTo(DrawCanvas, OptionsLbl.Left, OptionsLbl.Top, OptImage.GetWidth, OptImage.GetHeight, OptImage); end; end; procedure TEyMainForm.PaintPercent; var Percent: Double; begin if PercentLbl.Visible then begin if QuotaAsByte <> 0 then Percent := Round( (DownloadAsByte / QuotaAsByte) * 100 ) else Percent := 0.0; PercentLbl.Caption := '%' + FloatToStr(Percent); PaintLabelTo(DrawCanvas, PercentLbl, PercentLbl.Caption, StringAlignmentNear, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.ExitLblMouseEnter(Sender: TObject); begin CloseImage := CloseImageEnter; UpdateLayered; end; procedure TEyMainForm.ExitLblMouseLeave(Sender: TObject); begin CloseImage := CloseImageLeave; UpdateLayered; end; procedure TEyMainForm.HideLblMouseEnter(Sender: TObject); begin HideImage := HideImageEnter; UpdateLayered; end; procedure TEyMainForm.HideLblMouseLeave(Sender: TObject); begin HideImage := HideImageLeave; UpdateLayered; end; procedure TEyMainForm.PaintDetailsPanel; begin if DetailsPanel.Visible then begin DrawCanvas.FillRectangle(BackFillBrush, MakeRect(DetailsPanel.BoundsRect)); DrawCanvas.DrawRectangle(DownLinePen, MakeRect(DetailsPanel.BoundsRect)); PaintUpTitle; PaintUpload; PaintLeftSizeTitle; PaintLeftSize; PaintExcessTitle; PaintExcessSize; PaintPayTitle; PaintPay; end; end; procedure TEyMainForm.PaintUpload; begin if UpLbl.Visible then begin UpLbl.Caption := ': ' + GetUploadAsString(); PaintLabelTo(DrawCanvas, UpLbl, UpLbl.Caption, StringAlignmentNear, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.PaintUpTitle; begin if UpTitleLbl.Visible then begin PaintLabelTo(DrawCanvas, UpTitleLbl, UpTitleLbl.Caption, StringAlignmentFar, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.PaintLeftSize; begin if LeftSizeLbl.Visible then begin LeftSizeLbl.Caption := ': ' + GetLeftAsString(); PaintLabelTo(DrawCanvas, LeftSizeLbl, LeftSizeLbl.Caption, StringAlignmentNear, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.PaintLeftSizeTitle; begin if LeftSizeTitleLbl.Visible then begin PaintLabelTo(DrawCanvas, LeftSizeTitleLbl, LeftSizeTitleLbl.Caption, StringAlignmentFar, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; function TEyMainForm.GetLeftSize: Double; begin Result := QuotaAsByte - DownloadAsByte; if Result < 0 then Result := 0; end; function TEyMainForm.GetLeftAsString: string; var FormatType: TFormatType; begin if DefaultFormat then FormatType := ftDefault else FormatType := LeftFormat; Result := ConvertTo(GetLeftSize(), FormatType); end; function TEyMainForm.GetQuotaAsString: string; var FormatType: TFormatType; begin if DefaultFormat then FormatType := ftDefault else FormatType := QuotaFormat; Result := ConvertTo(QuotaAsByte, FormatType); end; procedure TEyMainForm.PaintWebLink; begin if WebLinkLbl.Visible then begin //WebLinkLbl.Caption := 'www.shenturk.com'; PaintLabelTo(DrawCanvas, WebLinkLbl, WebLinkLbl.Caption, StringAlignmentFar, WebLinkColor, True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.WebLinkLblMouseEnter(Sender: TObject); begin WebLinkColor := aclYellow; UpdateLayered; end; procedure TEyMainForm.WebLinkLblMouseLeave(Sender: TObject); begin WebLinkColor := $8FFFFFFF; UpdateLayered; end; procedure TEyMainForm.PaintExcessSize; begin if ExcessLbl.Visible then begin ExcessLbl.Caption := ': ' + GetExcessAsString(); PaintLabelTo(DrawCanvas, ExcessLbl, ExcessLbl.Caption, StringAlignmentNear, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.PaintExcessTitle; begin if ExcessTitleLbl.Visible then begin PaintLabelTo(DrawCanvas, ExcessTitleLbl, ExcessTitleLbl.Caption, StringAlignmentFar, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; function TEyMainForm.GetExcessSize: Double; begin Result := DownloadAsByte - QuotaAsByte; end; procedure TEyMainForm.WebLinkLblClick(Sender: TObject); begin ShellExecute(Self.Handle, 'open', MyHomePageURL + 'index.html', nil, nil, SW_SHOWNORMAL); end; procedure TEyMainForm.MouseTimerTimer(Sender: TObject); var P: TPoint; begin GetCursorPos(P); if PtInRect(Self.BoundsRect, P) then begin if (GetKeyState(VK_CONTROL) and $8000) <> 0 then HibernateActionExecute(Sender); end; end; procedure TEyMainForm.ShowOverflowMessage; begin SetStatusTextState(scTryOverflow); if FileExists(SoundsPath + OverflowWave) then MciPlayFile(SoundsPath + OverflowWave); NotifierForm.InitNotifierForm; NotifierForm.NotifyStyle := nfError; NotifierForm.TextData := #13#10'Tüm denemelere rağmen'#13#10 + 'güncelleme işlemi başarısızlıkla'#13#10 + 'sonuçlandı.'; NotifierForm.ShowForm; end; procedure TEyMainForm.WMAgreementDone(var Message: TMessage); var Result: Integer; Stream: TStringStream; begin if UserCanceled then Exit; Result := Message.LParam; if Result = scSuccess then begin with Thread.Request do begin Stream := TStringStream.Create(''); try //Response.ContentStream.SaveToFile('.\Cache\agreement.html'); Response.ContentStream.SaveToStream(Stream); QuotaInfoText := Stream.DataString; finally Stream.Free; end; end; GetQuotaInformationsThread; end else begin Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin SetStatusTextState(scUnexpected); EnableCountdownTimer(True); end; end; end; procedure TEyMainForm.WMGetQuotaDone(var Message: TMessage); var Result: Integer; Stream: TStringStream; begin if UserCanceled then Exit; Result := Message.LParam; if Result = scSuccess then begin with Thread.Request do begin Stream := TStringStream.Create(''); try Response.ContentStream.SaveToFile(DefQuotaPage); Response.ContentStream.SaveToStream(Stream); QuotaInfoText := Stream.DataString; finally Stream.Free; end; end; Result := ValidateQuotaInfo; if Result = scSuccess then begin SetStatusTextState(scSuccess); PostMessage(EyMainForm.Handle, WM_INETDONE, 0, Result); DoLogoutServerThread; //DoneLoginForm; end else begin Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin SetStatusTextState(Result); EnableCountdownTimer(True); end; end; end else begin Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin SetStatusTextState(scUnexpected); EnableCountdownTimer(True); end; end; end; procedure TEyMainForm.WMLoginPageDone(var Message: TMessage); var Result: Integer; ACookie: string; Stream: TStringStream; begin if UserCanceled then Exit; Result := Message.LParam; if Result = scSuccess then begin with Thread.Request do begin ACookie := Response.SetCookie; if ACookie <> '' then begin SetCookie := ACookie; ParseSetCookie; end; end; with Thread.Request do begin Stream := TStringStream.Create(''); try //Response.ContentStream.SaveToFile('.\Cache\login.html'); Response.ContentStream.SaveToStream(Stream); QuotaInfoText := Stream.DataString; finally Stream.Free; end; end; GetInetSecureImageThread; end else begin Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin SetStatusTextState(scNotResponse); EnableCountdownTimer(True); end; end; end; procedure TEyMainForm.WMPostFormDone(var Message: TMessage); var Result: Integer; Stream: TStringStream; begin if UserCanceled then Exit; Result := Message.LParam; if Result = scSuccess then begin with Thread.Request do begin Stream := TStringStream.Create(''); try Response.ContentStream.SaveToFile(DefPostPage); Response.ContentStream.SaveToStream(Stream); QuotaInfoText := Stream.DataString; finally Stream.Free; end; end; Result := CheckLoginError(); if Result = scSuccess then ConfirmAgreementThread else if Result = scInvalidUser then InvalidUserError else if Result = scInvalidPass then InvalidPasswordError else if Result = scNotRecognize then // No Message EnableCountdownTimer(True) else begin SetStatusTextState(Result); EnableCountdownTimer(True); end; end else begin Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin SetStatusTextState(scInvalidPost); EnableCountdownTimer(True); end; end; end; procedure TEyMainForm.WMSecureImgDone(var Message: TMessage); var Result: Integer; begin if UserCanceled then Exit; Result := Message.LParam; if Result = scSuccess then begin with Thread.Request do Response.ContentStream.SaveToFile(DefNameJpeg); // 'jcaptcha.jpg' LoadSecureImage(DefNameJpeg); //SetStatusTextState(scRecognizing); Result := GetRecognizedText; { DeleteFile(DefNameTiff); DeleteFile(DefNameTxt); } if Result = scSuccess then PostInternetFormThread else if Result = scUserCanceled then begin SetStatusTextState(scUserCanceled); CancelLogin; end else begin RecognizedText := 'Başarısız.'; //SetStatusTextState(scNotRecognize); Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin //SetStatusTextState(scNotRecognize); EnableCountdownTimer(True); end; end; end else begin Inc(TryCount); if TryCount > MaxTry then TryOverflowError else begin SetStatusTextState(scNotResponse); EnableCountdownTimer(True); end; end; end; procedure TEyMainForm.ParseSetCookie; var BeginPos, EndPos: Integer; AnyText: string; begin if SetCookie <> '' then begin BeginPos := Pos('JSESSIONID', SetCookie); if BeginPos > 0 then begin AnyText := Copy(SetCookie, BeginPos, MaxInt); EndPos := Pos(';', AnyText); if EndPos > 0 then SessionCookie := Copy(AnyText, BeginPos, EndPos - 1) else SessionCookie := AnyText; end; end; end; procedure TEyMainForm.ConfirmAgreementThread; begin //SetStatusTextState(scAgreement); if Assigned(Thread) then FreeAndNil(Thread); Thread := TInetThread.Create(Self.Handle, WM_AGREEMENTDONE, InetHandle); try with Thread.Request do begin Host := TTNetHost; URL := '/adslkota/confirmAgreement.do?dispatch=agree'; Connection := 'Keep-Alive'; if SessionCookie <> '' then Cookie := 'usageConfirm=true; ' + SessionCookie; end; Thread.Resume; except FreeAndNil(Thread); end; end; procedure TEyMainForm.GetInetLoginPageThread; begin Busy := True; SetStatusTextState(scConnecting); if Assigned(Thread) then FreeAndNil(Thread); if GetUserInfo(UserName, Password) then begin Thread := TInetThread.Create(Self.Handle, WM_LOGINPAGEDONE, InetHandle); try with Thread.Request do begin Host := TTNetHost; URL := '/adslkota/login.jsp'; Connection := 'Keep-Alive'; if SessionCookie <> '' then Cookie := 'usageConfirm=true; ' + SessionCookie; end; Thread.Resume; except FreeAndNil(Thread); end; end else begin UserCanceled := True; SetStatusTextState(scUserCanceled); CancelLogin; end; end; procedure TEyMainForm.GetInetSecureImageThread; begin //SetStatusTextState(scSecureCode); if Assigned(Thread) then FreeAndNil(Thread); Thread := TInetThread.Create(Self.Handle, WM_SECUREIMGDONE, InetHandle); try with Thread.Request do begin Host := TTNetHost; URL := '/adslkota/jcaptcha'; Connection := 'Keep-Alive'; if SessionCookie <> '' then Cookie := 'usageConfirm=true; ' + SessionCookie; end; Thread.Resume; except FreeAndNil(Thread); end; end; procedure TEyMainForm.GetQuotaInformationsThread; begin SetStatusTextState(scGettingData); if Assigned(Thread) then FreeAndNil(Thread); Thread := TInetThread.Create(Self.Handle, WM_GETQUOTADONE, InetHandle); try with Thread.Request do begin Host := TTNetHost; URL := '/adslkota/viewTransfer.do?dispatch=entry'; Connection := 'Keep-Alive'; if SessionCookie <> '' then Cookie := 'usageConfirm=true; ' + SessionCookie; end; Thread.Resume; except FreeAndNil(Thread); end; end; procedure TEyMainForm.PostInternetFormThread; begin SetStatusTextState(scEntering); if Assigned(Thread) then FreeAndNil(Thread); Thread := TInetThread.Create(Self.Handle, WM_POSTFORMDONE, InetHandle); try with Thread.Request do begin Host := TTNetHost; Method := 'POST'; URL := '/adslkota/loginSelf.do'; Connection := 'Keep-Alive'; if SessionCookie <> '' then Cookie := 'usageConfirm=true; ' + SessionCookie; ContentType := 'application/x-www-form-urlencoded'; Content := 'dispatch=login&userName=' + UserName + '&password=' + Password + '&captchaResponse=' + RecognizedText; end; Thread.Resume; except FreeAndNil(Thread); end; end; function TEyMainForm.ValidateQuotaInfo: Integer; var Engine: TURESearch; // (URE) Unicode Regular Expression StartPos, StopPos: Cardinal; begin Result := scInvalidData; if QuotaInfoText = '' then Exit; Engine := TURESearch.Create(nil); try StartPos := 0; StopPos := 0; Engine.FindPrepare('[0-9]*-[0-9]*-[0-9]* [0-9]*:[0-9]*:[0-9]*', []); // for DateTime if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scSuccess else begin Engine.FindPrepare('Sistem Hatası', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scSystemError; end; finally Engine.Free; end; end; procedure TEyMainForm.TryOverflowError; begin PostMessage(EyMainForm.Handle, WM_INETDONE, 0, scTryOverflow); SetStatusTextState(scTryOverflow); DoneLoginForm; end; procedure TEyMainForm.SetStatusTextState(const StateCode: Integer); var StateText: WideString; begin StateText := GetStatusText(StateCode); SetStatusText(StateText); end; procedure TEyMainForm.EnableCountdownTimer(Enable: Boolean); begin Countdown.Enabled := Enable; end; procedure TEyMainForm.LoadSecureImage(const FileName: string); // Alogoritma biraz zayif. Asil Palette-Weighted olsa super olacak! function ConvertMonochrome(Image: TGPBitmap): TGPBitmap; var W, H: DWORD; SrcBmp, DestBmp: HBITMAP; PBI: PBITMAPINFO; PBits: Pointer; DC, MemDC, DestDC: HDC; begin W := Image.GetWidth(); H := Image.GetHeight(); GetMem(PBI, SizeOf(TBitmapInfo) + 2 * SizeOf(TRGBQuad)); try Image.GetHBITMAP(0, SrcBmp); with PBI^.bmiHeader do begin biSize := 40; biWidth := W; biHeight := H; biPlanes := 1; biBitCount := 1; biCompression := BI_RGB; biSizeImage := ( ( (W + 7) or $FFFFFFF8 ) * H div 8 ); biXPelsPerMeter := 1000000; biYPelsPerMeter := 1000000; biClrUsed := 2; biClrImportant := 2; end; DWORD(PBI^.bmiColors[0]) := 0; PDWORD(Integer(@PBI^.bmiColors) + SizeOf(Integer))^ := $FFFFFFFF; DestBmp := CreateDIBSection(0, PBI^, DIB_RGB_COLORS, PBits, 0, 0 ); DC := GetDC(0); MemDC := CreateCompatibleDC(DC); SelectObject(MemDC, SrcBmp); DestDC := CreateCompatibleDC(DC); SelectObject(DestDC, DestBmp); BitBlt(DestDC, 0, 0, W, H, MemDC, 0, 0, SRCCOPY); Result := Image.FromHBITMAP(DestBmp, 0); DeleteDC(MemDC); DeleteDC(DestDC); ReleaseDC(0, DC); DeleteObject(SrcBmp); DeleteObject(DestBmp); finally FreeMem(PBI); end; end; procedure SaveAsMonoTiff(SrcImage: TGPBitmap; const DestName: string); var MonoImage: TGPBitmap; CodecId: TGUID; EP: TEncoderParameters; Compression: Cardinal; begin if GetEncoderClsid('image/tiff', CodecId) <> -1 then begin MonoImage := ConvertMonochrome(SrcImage); try if Assigned(MonoImage) then begin EP.Count := 1; // Dikkat. Compression Yok! Yoksa tesseract cozemez. Compression := Cardinal(EncoderValueCompressionNone); with EP do begin Parameter[0].Guid := EncoderCompression; Parameter[0].Type_ := EncoderParameterValueTypeLong; Parameter[0].NumberOfValues := 1; Parameter[0].Value := @Compression; end; MonoImage.Save(DestName, CodecId, @EP); end; finally FreeAndNil(MonoImage); end; end; end; begin ReleaseSecureImage; SecureImage := TGPBitmap.Create(FileName); SaveAsMonoTiff(SecureImage, DefNameTiff); UpdateLayered; end; procedure TEyMainForm.ReleaseSecureImage; begin RecognizedText := ''; if Assigned(SecureImage) then FreeAndNil(SecureImage); end; function TEyMainForm.GetRecognizedText: Integer; begin Result := Recognize(ImageName, RecognizedText); end; procedure TEyMainForm.SetStatusText(const Text: WideString); begin StatusTextLbl.Caption := Text; UpdateLayered; end; procedure TEyMainForm.ResetCountdown; begin TimeLeft := TryPeriod; UpdateLayered; end; procedure TEyMainForm.DoneLoginForm; begin Screen.Cursor := crHourGlass; if Assigned(Thread) then begin Thread.WaitFor; FreeAndNil(Thread); end; Screen.Cursor := crDefault; if UserCanceled then SetStatusTextState(scUserCanceled); RecognizedText := ''; EnableStarterTimer(False); EnableCountdownTimer(False); ReleaseSecureImage; Busy := False; EnableEvents; end; procedure TEyMainForm.InitLoginForm; begin DisableEvents; TryCount := 1; Busy := False; UserCanceled := False; EnableCountdownTimer(False); ResetCountdown; ReleaseSecureImage; SetStatusTextState(scConnecting); end; function TEyMainForm.Recognize(const FileName: string; var RecgText: WideString): Integer; begin if UseOCR then Result := UseTesseract(FileName, RecgText) else Result := UseEntry(FileName, RecgText); end; function TEyMainForm.UseEntry(const FileName: string; var RecgText: WideString): Integer; begin if not Assigned(ModiLessForm) then ModiLessForm := TModiLessForm.Create(Self); ModiLessForm.InitModiLessForm; //Hibernate; Result := ModiLessForm.ShowModalForm; if Result = mrOK then begin RecgText := ModiLessForm.EntryEdit.Text; Result := scSuccess; end else Result := scUserCanceled; //Wakeup; end; function TEyMainForm.UseTesseract(const FileName: string; var RecgText: WideString): Integer; var FileStream: TFileStream; StringStream: TStringStream; AnyText: string; function SkipBlanks(const AText: string): string; var I: Integer; Ch: Char; begin Result := ''; for I := 1 to Length(AText) do begin Ch := AText[I]; if Ch in ['a'..'z', 'A'..'Z', '0'..'9'] then begin if Ch = '0' then Ch := 'o'; if Ch = '1' then Ch := 'l'; if Ch = '2' then Ch := 'z'; if Ch = '5' then Ch := 's'; if Ch = '8' then Ch := 'a'; if Ch = '9' then Ch := 'g'; Result := Result + Ch; end; end; Result := LowerCase(Result); end; begin Result := scNotRecognize; if ExecuteTesseract(DefNameTiff, DefNameTess) = scSuccess then begin FileStream := TFileStream.Create(DefNameTxt, fmOpenRead); try StringStream := TStringStream.Create(''); try StringStream.CopyFrom(FileStream, FileStream.Size); AnyText := StringStream.DataString; AnyText := Trim(AnyText); RecgText:= SkipBlanks(AnyText); if RecgText <> '' then Result := scSuccess; finally StringStream.Free; end; finally FileStream.Free; end; end; end; function TEyMainForm.GetUserInfo(var AUserName, APassword: string): Boolean; var AnyInt: Integer; begin Result := GetSubscribeInfo(AUserName, APassword, AnyInt); end; function TEyMainForm.GetStatusText(const StatusCode: Integer): WideString; begin case StatusCode of scConnecting : Result := 'Bağlantı kuruluyor...'; scSecureCode : Result := 'Güvenlik Kodu alınıyor...'; scRecognizing : Result := 'Kod çözülüyor...'; scEntering : Result := 'Giriş yapılıyor... '; scAgreement : Result := 'Şözleşme kabul ediliyor...'; scGettingData : Result := 'Bilgiler alınıyor...'; scCancel : Result := 'İptal ediliyor.Lütfen Bekleyin...'; scRetrying : Result := 'Yeniden deneniyor...'; scTryOverflow : Result := 'Tüm denemeler başarısız.'; scNotChange : Result := 'Değişiklik yok!'; scUpdated : Result := 'Kota bilgileriniz güncellendi!'; scSuccess : Result := 'İşlem Tamam!'; scNotResponse : Result := 'Sunucu yanıt vermiyor!'; scNotRecognize : Result := 'Güvenlik Kodu çözülemedi!'; scInvalidPost : Result := 'Geçersiz giriş.Yeniden denenecek!'; scUnexpected : Result := 'Beklenmeyen hata!'; scInvalidData : Result := 'Geçersiz veri.Yeniden denenecek!'; scSystemError : Result := 'Sunucu hatası!'; scUserCanceled : Result := 'İşlemi iptal ettiniz!'; scInvalidUser : Result := 'Kullanıcı adı geçersiz!'; scInvalidPass : Result := 'Dikkat! Şifre yanlış!'; scEndSession : Result := 'Oturum sonlanmış!'; scLogout : Result := 'Oturum sonlandırılıyor.'; else Result := WideFormat('Bilinmeyen Hata! (%d)', [StatusCode] ); end; end; procedure TEyMainForm.StartLogin(StartVisible: Boolean); begin Busy := True; EnableStarterTimer(True); end; procedure TEyMainForm.CountdownTimer(Sender: TObject); begin if TimeLeft > 0 then Dec(TimeLeft) else begin EnableCountdownTimer(False); EnableStarterTimer(True); SetStatusTextState(scRetrying); ResetCountdown; UpdateLayered; end; end; procedure TEyMainForm.StarterTimerTimer(Sender: TObject); begin EnableStarterTimer(False); ReleaseSecureImage; GetInetLoginPageThread; end; procedure TEyMainForm.EnableStarterTimer(Enable: Boolean); begin StarterTimer.Enabled := Enable; end; procedure TEyMainForm.CancelLogin; begin UserCanceled := True; SetStatusTextState(scCancel); DoneLoginForm; end; procedure TEyMainForm.ShowNotChangeMessage; begin SetStatusTextState(scNotChange); if not NotifyMe then Exit; case NotifyType of ntAuditory : PlayNotChangeSound; ntVisual : ShowNotChangeForm; else begin PlayNotChangeSound; ShowNotChangeForm; end; end; end; procedure TEyMainForm.ShowInfoMessage; begin SetStatusTextState(scUpdated); if not NotifyMe then Exit; case NotifyType of ntAuditory : PlayInfoSound; ntVisual : ShowInfoForm; else begin PlayInfoSound; ShowInfoForm; end; end; end; procedure TEyMainForm.NormalViewActExecute(Sender: TObject); begin if ViewStyle <> vsNormal then SetViewStyle(vsNormal); end; procedure TEyMainForm.BriefViewActExecute(Sender: TObject); begin if ViewStyle <> vsBrief then SetViewStyle(vsBrief); end; procedure TEyMainForm.CancelRefreshActExecute(Sender: TObject); begin if Assigned(ModiLessForm) and (ModiLessForm.Visible) then ModiLessForm.CancelLblClick(Self); UserCanceled := True; SetStatusTextState(scUserCanceled); CancelLogin; end; procedure TEyMainForm.SetBriefViewStyle; procedure SetupBriefBounds; begin Self.Width := 208; Self.Height := 90; DownTitleLbl.Top := 2; DownPanel.Top := DownTitleLbl.Top + 6; DownLbl.Top := DownTitleLbl.Top + 22; DownBarLbl.Top := DownTitleLbl.Top + 38; PercentLbl.Top := DownTitleLbl.Top + 40; StatusTextLbl.Top := DownTitleLbl.Top + 64; DownTitleLbl.Left := 10; DownPanel.Left := DownTitleLbl.Left - 8; DownLbl.Left := DownTitleLbl.Left - 4; DownBarLbl.Left := DownTitleLbl.Left + 19; PercentLbl.Left := DownTitleLbl.Left + 147; StatusTextLbl.Left := DownTitleLbl.Left - 8; SetWorkArea; // Ekranin disindaysa duzelt? end; begin BackgrndLbl.Visible := False; CaptionLbl.Visible := False; ExitLbl.Visible := False; HideLbl.Visible := False; OptionsLbl.Visible := False; DetailsPanel.Visible := False; WebLinkLbl.Visible := False; SetupBriefBounds; end; procedure TEyMainForm.SetNormalViewStyle; procedure SetupNormalBounds; begin Self.Width := 239; Self.Height := 227; DownTitleLbl.Top := 40; DownPanel.Top := DownTitleLbl.Top + 6; DownLbl.Top := DownTitleLbl.Top + 22; DownBarLbl.Top := DownTitleLbl.Top + 38; PercentLbl.Top := DownTitleLbl.Top + 40; StatusTextLbl.Top := DownTitleLbl.Top + 138; DownTitleLbl.Left := 27; DownPanel.Left := DownTitleLbl.Left - 8; DownLbl.Left := DownTitleLbl.Left - 4; DownBarLbl.Left := DownTitleLbl.Left + 19; PercentLbl.Left := DownTitleLbl.Left + 147; StatusTextLbl.Left := DownTitleLbl.Left - 8; SetWorkArea; // Ekranin disindaysa duzelt? end; begin BackgrndLbl.Visible := True; CaptionLbl.Visible := True; ExitLbl.Visible := True; HideLbl.Visible := True; OptionsLbl.Visible := True; DetailsPanel.Visible := True; WebLinkLbl.Visible := True; SetupNormalBounds; end; procedure TEyMainForm.SetViewStyle(const AViewStyle: TViewStyle); begin ViewStyle := AViewStyle; HideMainForm; IniFile.WriteInteger(sGeneral, sViewStyle, Integer(ViewStyle)); IniFile.UpdateFile; case ViewStyle of vsBrief: SetBriefViewStyle; else SetNormalViewStyle; end; UpdateLayered; ShowMainForm; end; procedure TEyMainForm.PaintStatusText; var R: TRect; begin if StatusTextLbl.Visible then begin R := StatusTextLbl.BoundsRect; OffsetRect(R, 0, -1); DrawCanvas.FillRectangle(BackFillBrush, MakeRect(R)); DrawCanvas.DrawRectangle(DownLinePen, MakeRect(R)); PaintLabelTo(DrawCanvas, StatusTextLbl, StatusTextLbl.Caption, StringAlignmentCenter, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.PaintDonateLabel; begin if DonateLbl.Visible then PaintLabelTo(DrawCanvas, DonateLbl, DonateLbl.Caption, StringAlignmentNear, DonateColor, True, TextRenderingHintAntiAliasGridFit); end; procedure TEyMainForm.StatusTimerTimer(Sender: TObject); begin StatusTimer.Enabled := False; SetStatusText(WideFormat('IP Adresim: %s', [IPAddressStr])); end; // Sadece test dosyasini yukler. function TEyMainForm.GetTestText: WideString; var FileStream: TFileStream; StringStream: TStringStream; begin FileStream := TFileStream.Create('quota4.txt', fmOpenRead); try StringStream := TStringStream.Create(''); try StringStream.CopyFrom(FileStream, FileStream.Size); Result := StringStream.DataString; finally StringStream.Free; end; finally FileStream.Free; end; end; procedure TEyMainForm.ShowDetailsActExecute(Sender: TObject); begin ShowDetailsAct.Checked := not ShowDetailsAct.Checked; if ShowDetailsAct.Checked then DetailsForm.ShowForm else DetailsForm.HideForm; end; function TEyMainForm.ConvertToKiloByte(const Value: Double): string; begin if UseInteger then Result := FormatFloat('#,0 KB', Value / KiloByte) else Result := FormatFloat('#,###0.000 KB', Value / KiloByte); end; function TEyMainForm.ConvertToMegaByte(const Value: Double): string; begin if UseInteger then Result := FormatFloat('#,0 MB', Value / MegaByte) else Result := FormatFloat('#,###0.000 MB', Value / MegaByte); end; function TEyMainForm.ConvertToGigaByte(const Value: Double): string; begin Result := FormatFloat('#,###0.000 GB', Value / GigaByte); end; function TEyMainForm.ConvertToByte(const Value: Double): string; begin Result := FormatFloat('#,0 B', Value); end; function TEyMainForm.GetDownloadAsString: string; var FormatType: TFormatType; begin if DefaultFormat then FormatType := ftDefault else FormatType := DownFormat; Result := ConvertTo(DownloadAsByte, FormatType); end; function TEyMainForm.GetUpLoadAsString: string; var FormatType: TFormatType; begin if DefaultFormat then FormatType := ftDefault else FormatType := UpFormat; Result := ConvertTo(UploadAsByte, FormatType); end; procedure TEyMainForm.PaintPay; begin if PayLabel.Visible then begin PayLabel.Caption := ': ' + GetPayText(); PaintLabelTo(DrawCanvas, PayLabel, PayLabel.Caption, StringAlignmentNear, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; procedure TEyMainForm.PaintPayTitle; begin if PayTitleLbl.Visible then begin PaintLabelTo(DrawCanvas, PayTitleLbl, PayTitleLbl.Caption, StringAlignmentFar, ColorRefToARGB(TextColor), True, TextRenderingHintAntiAliasGridFit); end; end; function TEyMainForm.GetPayText: WideString; var Invoice, Excess: Double; MaxPay: Double; begin Excess := GetExcessSize(); if Excess < 0 then Excess := 0.0; Invoice := MonthlyPay + (Excess / MegaByte) * PayPerMB; MaxPay := MaxPayRef * (1.00 + PayPercent / 100.00); if Invoice >= MaxPay then Invoice := MaxPay; Result := FormatFloat('#,##0.00 YTL', Invoice); if Excess > 0 then begin if Invoice < MaxPay then Result := Result + ' (' + FormatFloat('#,##0.00', MonthlyPay) + '+' + FormatFloat('#,##0.00', (Excess / MegaByte) * PayPerMB) + ')' else Result := Result + ' (Maksimum)'; end; end; procedure TEyMainForm.DonateLblMouseEnter(Sender: TObject); begin DonateColor := aclYellow; UpdateLayered; end; procedure TEyMainForm.DonateLblMouseLeave(Sender: TObject); begin DonateColor := $8FFFFFFF; UpdateLayered; end; function TEyMainForm.BytesToString(Value: Double): string; begin if Value < KiloByte then Result := FormatFloat('#,0 B', Value) else if Value < MegaByte then begin if UseInteger then Result := FormatFloat('#,0 KB', Value / KiloByte) else Result := FormatFloat('#,###0.000 KB', Value / KiloByte); end else if Value < GigaByte then begin if UseInteger then Result := FormatFloat('#,0 MB', Value / MegaByte) else Result := FormatFloat('#,###0.000 MB', Value / MegaByte); end else Result := FormatFloat('#,###0.000 GB', Value / GigaByte); end; function TEyMainForm.CheckLoginError: Integer; var Engine: TURESearch; StartPos, StopPos: Cardinal; begin Result := scInvalidData; if QuotaInfoText = '' then Exit; Engine := TURESearch.Create(nil); try StartPos := 0; StopPos := 0; Engine.FindPrepare('İşlem Hatası', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then begin Engine.FindPrepare('Sistem Hatası', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scSystemError else begin Engine.FindPrepare('Giriş başarısız', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scInvalidUser else begin Engine.FindPrepare('Güvenlik kodu doğru değil', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scNotRecognize else begin Engine.FindPrepare('Girilen şifre hatalıdır', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scInvalidPass else Result := scUnexpected; end; end; end; end else begin Engine.FindPrepare('Oturum sonlandı', []); if Engine.FindFirst(QuotaInfoText, StartPos, StopPos) then Result := scEndSession else Result := scSuccess end; finally Engine.Free; end; end; procedure TEyMainForm.InvalidUserError; begin PostMessage(EyMainForm.Handle, WM_INETDONE, 0, scInvalidUser); SetStatusTextState(scInvalidUser); DoneLoginForm; end; procedure TEyMainForm.InvalidPasswordError; begin PostMessage(EyMainForm.Handle, WM_INETDONE, 0, scInvalidPass); SetStatusTextState(scInvalidPass); DoneLoginForm; end; procedure TEyMainForm.ShowInvalidUserMessage; begin SetStatusTextState(scInvalidUser); if FileExists(SoundsPath + InvalidUserWave) then MciPlayFile(SoundsPath + InvalidUserWave); NotifierForm.InitNotifierForm; NotifierForm.NotifyStyle := nfError; NotifierForm.TextData := #13#10'Dikkat!'#13#10 + 'Kullanıcı adınız geçersiz!'#13#10 + 'Lütfen kullanıcı adınızı doğru'#13#10 + 'olarak giriniz!'#13#10; NotifierForm.ShowForm; end; procedure TEyMainForm.ShowInvalidPassMessage; begin SetStatusTextState(scInvalidPass); if FileExists(SoundsPath + InvalidPassWave) then MciPlayFile(SoundsPath + InvalidPassWave); NotifierForm.InitNotifierForm; NotifierForm.NotifyStyle := nfError; NotifierForm.TextData := #13#10'Dikkat!'#13#10 + 'Geçersiz şifre belirtmişsiniz!'#13#10 + 'Lütfen şifrenizi doğru olarak'#13#10 + 'giriniz!'#13#10; NotifierForm.ShowForm; end; function TEyMainForm.GetExcessAsString: WideString; var FormatType: TFormatType; begin ExcessAsByte := GetExcessSize(); if ExcessAsByte <= 0 then ExcessAsByte := 0; if ExcessAsByte <= 0 then Result := 'Kota aşılmamış.' else begin if DefaultFormat then FormatType := ftDefault else FormatType := ExcessFormat; Result := ConvertTo(ExcessAsByte, FormatType); end; end; procedure TEyMainForm.SetWorkArea; var R: TRect; begin IntersectRect(R, Screen.WorkAreaRect, Self.BoundsRect); if IsRectEmpty(R) then begin Self.Left := Screen.WorkAreaWidth - Self.Width; Self.Top := Screen.WorkAreaHeight - Self.Height; end; end; function TEyMainForm.ConvertTo(const Value: Double; FormatType: TFormatType): string; begin case FormatType of ftByte : Result := ConvertToByte(Value); ftKiloByte: Result := ConvertToKiloByte(Value); ftMegaByte: Result := ConvertToMegaByte(Value); ftGigaByte: Result := ConvertToGigaByte(Value); else Result := BytesToString(Value); end; end; procedure TEyMainForm.WMQueryEndSession(var Message: TWMQueryEndSession); begin Message.Result := Integer(True); end; procedure TEyMainForm.WMEndSession(var Message: TWMEndSession); begin DetailsForm.HideForm; DetailsForm.SaveOptions; TrafficForm.HideForm; TrafficForm.SaveOptions; Self.HideMainForm; Self.SaveOptions; IniFile.UpdateFile; inherited; end; procedure TEyMainForm.DonateLblClick(Sender: TObject); begin ShellExecute(Self.Handle, 'open', MyHomePageURL + 'donates.html', nil, nil, SW_SHOWNORMAL); end; procedure TEyMainForm.MciClose; begin if mciSendCommand( DeviceID, MCI_CLOSE, MCI_WAIT, 0) = 0 then DeviceID := 0; end; procedure TEyMainForm.MciPlayFile(const WaveName: string); var mciOpenParms: MCI_OPEN_PARMS; mciPlayParms: MCI_PLAY_PARMS; begin if DeviceID <> 0 then MciClose; FillChar(mciOpenParms, SizeOf(mciOpenParms), 0); mciOpenParms.lpstrDeviceType := 'waveaudio'; mciOpenParms.lpstrElementName := PChar(WaveName); if mciSendCommand(0, MCI_OPEN, MCI_OPEN_TYPE or MCI_OPEN_ELEMENT, DWORD(@mciOpenParms)) = 0 then begin DeviceID := mciOpenParms.wDeviceID; FillChar(mciPlayParms, SizeOf(mciPlayParms), 0); mciPlayParms.dwCallback := Self.Handle; if mciSendCommand(DeviceID, MCI_PLAY, MCI_NOTIFY, DWORD(@mciPlayParms)) <> 0 then begin mciSendCommand(DeviceID, MCI_CLOSE, 0, 0); DeviceID := 0; end; end; end; procedure TEyMainForm.MMMciNotify(var Message: TMessage); begin if mciSendCommand(Message.LParam, MCI_CLOSE, MCI_WAIT, 0) = 0 then DeviceID := 0; end; procedure TEyMainForm.ShowNotChangeForm; begin NotifierForm.InitNotifierForm; NotifierForm.NotifyStyle := nfNotChange; NotifierForm.TextData := #13#10'Kota bilgilerinizde değişiklik yok.'#13#10 + GetPeriodText + #13#10 + 'Download ' + BytesToString(DownloadAsByte) + ',' + #13#10 + 'Upload ' + BytesToString(UploadAsByte) + ',' + #13#10 + 'Kayıt Zamanı ' + RecordTimeStr; NotifierForm.ShowForm; end; procedure TEyMainForm.PlayNotChangeSound; begin if FileExists(SoundsPath + NotChangeWave) then MciPlayFile(SoundsPath + NotChangeWave); end; procedure TEyMainForm.PlayInfoSound; begin if FileExists(SoundsPath + InfoWave) then MciPlayFile(SoundsPath + InfoWave); end; procedure TEyMainForm.ShowInfoForm; begin NotifierForm.InitNotifierForm; NotifierForm.NotifyStyle := nfInfo; NotifierForm.TextData := #13#10'Kota bilgileriniz güncellendi.'#13#10 + GetPeriodText + #13#10 + 'Download ' + BytesToString(DownloadAsByte) + ',' + #13#10 + 'Upload ' + BytesToString(UploadAsByte) + ',' + #13#10 + 'Kayıt Zamanı ' + RecordTimeStr; NotifierForm.ShowForm; end; function TEyMainForm.CheckAlertPercent: Boolean; var Percent: Integer; begin Percent := Round((DownloadAsByte / QuotaAsByte) * 100); Result := Percent >= AlertPercent; end; procedure TEyMainForm.CheckHibernateAlert; var HibernateForm: THibernateForm; begin HibernateAlert := IniFile.ReadBool(sGeneral, sHibernateAlert, True); if (not HibernateAlert) or (AlertShow) then Exit; HibernateForm := THibernateForm.Create(Self); try AlertShow := True; HibernateForm.ShowModal; finally AlertShow := False; HibernateForm.Free; end; end; procedure TEyMainForm.RunWizardActExecute(Sender: TObject); var WizardForm: TWizardForm; CheckNow: Boolean; Result: Integer; VersionCheck: Boolean; begin VersionCheck := VersionTimer.Enabled; VersionTimer.Enabled := False; WizardForm := TWizardForm.Create(Self); try TrayIcon.Visible := False; Result := WizardForm.ShowModal; CheckNow := WizardForm.CheckBox1.Checked; finally TrayIcon.Visible := True; WizardForm.Free; end; SaveOptions; if Result = mrYes then begin LoadOptions; DetailsForm.UpdateDetails; TrafficForm.ChangeAdapter; TrafficForm.LoadOptionsInterrupt; if CheckNow then RefreshActionExecute(Self); end; VersionTimer.Enabled := VersionCheck; end; function TEyMainForm.GetTrayHintText: WideString; begin Result := WideFormat( 'Ey DSL! çalışıyor.'#13#10 + 'Download: %s (%s)'#13#10 + 'Kalan: %s'#13#10 + 'Aşan: %s'#13#10 + 'Ücret: %s', [GetDownloadAsString(), GetPercentAsString(), GetLeftAsString(), GetExcessAsString(), GetPayText()]); end; procedure TEyMainForm.UpdateTrayHintText; begin TrayIcon.Hint := GetTrayHintText(); end; function TEyMainForm.GetPercentAsString: WideString; var Percent: Double; begin if QuotaAsByte <> 0 then Percent := Round( (DownloadAsByte / QuotaAsByte) * 100 ) else Percent := 0.0; Result := FormatFloat('%#,0', Percent); end; procedure TEyMainForm.StartupFirstUsage; var WizardForm: TWizardForm; CheckNow: Boolean; Result: Integer; VersionCheck: Boolean; begin VersionCheck := VersionTimer.Enabled; VersionTimer.Enabled := False; WizardForm := TWizardForm.Create(Self); try TrayIcon.Visible := False; Result := WizardForm.ShowModal; CheckNow := WizardForm.CheckBox1.Checked; finally TrayIcon.Visible := True; WizardForm.Free; end; SaveOptions; if Result = mrYes then begin LoadOptions; DetailsForm.UpdateDetails; TrafficForm.ChangeAdapter; TrafficForm.LoadOptionsInterrupt; TrayIcon.ShowBalloonHint; end; if ViewStyle = vsBrief then SetBriefViewStyle else SetNormalViewStyle; NormalViewAct.Checked := ViewStyle = vsNormal; BriefViewAct.Checked := ViewStyle = vsBrief; UpdateLayered; ShowMainForm; FetchIPAddress; if ShowNetMonitor then ShowTrafficActExecute(Self); if UpdateStartup then begin StatusTimer.Enabled := False; if CheckNow and (Result = mrYes) then RefreshActionExecute(Self); end else StatusTimer.Enabled := True; VersionTimer.Enabled := VersionCheck; end; procedure TEyMainForm.StartupNormal; begin if ViewStyle = vsBrief then SetBriefViewStyle else SetNormalViewStyle; NormalViewAct.Checked := ViewStyle = vsNormal; BriefViewAct.Checked := ViewStyle = vsBrief; UpdateLayered; ShowMainForm; FetchIPAddress; if ShowNetMonitor then ShowTrafficActExecute(Self); if UpdateStartup then begin StatusTimer.Enabled := False; RefreshActionExecute(Self); end else StatusTimer.Enabled := True; end; procedure TEyMainForm.CheckVersion; begin if Assigned(VersionThread) then begin if not VersionThread.Terminated then Exit; end; if Assigned(VersionThread) then FreeAndNil(VersionThread); VersionStr := ''; VersionXML := ''; VersionThread := TInetThread.Create(Self.Handle, WM_VERSIONDONE, InetHandle); try with VersionThread.Request do begin Host := MyHomeHost; URL := '/eydslver.xml'; end; VersionThread.Resume; except FreeAndNil(VersionThread); end; end; procedure TEyMainForm.ParseVersionXML; var xmlPage, Elem: OleVariant; begin if VersionXML = '' then Exit; xmlPage := CreateOleObject('Microsoft.XMLDOM'); try if not VarIsClear(xmlPage) then begin if xmlPage.LoadXml(VersionXML) then begin // /data/version Elem := xmlPage.documentElement.selectSingleNode('/data/version'); try if not VarIsClear(Elem) then VersionStr := Elem.Text; finally Elem := Unassigned; end; end; end; finally xmlPage := Unassigned; end; end; procedure TEyMainForm.WMVersionDone(var Message: TMessage); var Stream: TStringStream; begin VersionXML := ''; if Message.LParam = 0 then begin Stream := TStringStream.Create(''); try with VersionThread.Request.Response do begin ContentStream.SaveToStream(Stream); VersionXML := Stream.DataString; end; finally Stream.Free; end; ParseVersionXML; end; if Assigned(VersionThread) then FreeAndNil(VersionThread); if (VersionStr <> '') and (CompareText(sCurrVersion, VersionStr) < 0) then begin if Application.MessageBox(PChar(Format(sUpdateMessage, [VersionStr])), 'Güncelleme', MB_ICONQUESTION or MB_YESNO) = IDYES then ShellExecute(Self.Handle, 'open', MyHomePageURL + 'downloads.asp#eydsl', nil, nil, SW_SHOWNORMAL); end; end; procedure TEyMainForm.VersionTimerTimer(Sender: TObject); begin VersionTimer.Enabled := False; CheckVersion; end; procedure TEyMainForm.DoLogoutServerThread; begin //SetStatusTextState(scLogout); if Assigned(Thread) then FreeAndNil(Thread); Thread := TInetThread.Create(Self.Handle, WM_LOGOUTDONE, InetHandle); try with Thread.Request do begin Host := TTNetHost; URL := '/adslkota/logout.do'; Connection := 'Keep-Alive'; if SessionCookie <> '' then Cookie := 'usageConfirm=true; ' + SessionCookie; end; Thread.Resume; except FreeAndNil(Thread); end; end; procedure TEyMainForm.WMLogoutDone(var Message: TMessage); var Result: Integer; begin if UserCanceled then Exit; Result := Message.LParam; if Result = scSuccess then begin { with Thread.Request do Response.ContentStream.SaveToFile('.\Cache\logout.html'); } DoneLoginForm; end; end; procedure TEyMainForm.ShowTaskbarButton(CmdShow: Boolean); var dwStyle: DWORD; begin dwStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE); if CmdShow then begin if dwStyle and WS_EX_TOOLWINDOW <> 0 then begin SetWindowLong(Application.Handle, GWL_EXSTYLE, dwStyle and not WS_EX_TOOLWINDOW); ShowWindow(Application.Handle, SW_SHOW); end; end else begin if dwStyle and WS_EX_TOOLWINDOW = 0 then begin ShowWindow(Application.Handle, SW_HIDE); SetWindowLong(Application.Handle, GWL_EXSTYLE, dwStyle or WS_EX_TOOLWINDOW); end; end; SetWindowPos(Application.Handle, 0, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER or SWP_FRAMECHANGED); end; procedure TEyMainForm.SetColorsDrawItems; begin BackFillBrush.SetColor(MakeColor(BackFillOpacity, GetRValue(BackFillColor), GetGValue(BackFillColor), GetBValue(BackFillColor))); end; end.