SiteChecker - утилита оптимизации сайта. Сгрузить MSI-файл.
Эта моя утилита предназначена для опитимизации сайта в процессе его просмотра поисковой машиной и автоматизирует следующие распространенные сценарии работы с сайтом:
- Просмотр всех страниц проекта и проверку их
- Установку заголовка страницы
- Установку ключевых слов страницы
- Проверку всех ссылок на странице (локалых и в интернете)
- Проверку страницы на ключевые слова
- Запись модифицированных страниц на FTP
- ведение файла robot.txt
В первую очередь эта программа эффективна для больших HTML-сайтов (типа моего хомяка, где более 10 тыс страниц). Такие программы я встречал только платные в инете и поэтому решил выложить тут этот текст с открытым исходным кодом. Дополнить его какой-либо функциональностью, например выбросить символы возврата каретки не представляет сложности, между тем проги только с такой единственной функциональностью (например SpaceAgent) стоят десятки долларов или требуют крека и прочих проблем. Поэтому, надеюсь, что эта моя прога (сделанная мною не на работе, а в личное время) будет полезна многим и послужит основанием многих проектов.
Я оформил ее в виде единственной формы (ну плюс формочки регистрации доступа к FTP), хотя это можно сделать и для MDI-проекта. Особенно в случае существенного расширения функциональности:
Далее показан исходный текст главной формы (скрин которой вы видите выше). Разумеется в студии он выглядит намного приятнее. Основной фишкой, как вы видите, является тут использование SplitPanel, из-за чего форма автоматически масштабируется средствами NET2:
00001: <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ 00002: Partial Class Main 00003: Inherits System.Windows.Forms.Form 00004: 00005: 'Form overrides dispose to clean up the component list. 00006: <System.Diagnostics.DebuggerNonUserCode()> _ 00007: Protected Overrides Sub Dispose(ByVal disposing As Boolean) 00008: Try 00009: If disposing AndAlso components IsNot Nothing Then 00010: components.Dispose() 00011: End If 00012: Finally 00013: MyBase.Dispose(disposing) 00014: End Try 00015: End Sub 00016: 00017: 'Required by the Windows Form Designer 00018: Private components As System.ComponentModel.IContainer 00019: 00020: 'NOTE: The following procedure is required by the Windows Form Designer 00021: 'It can be modified using the Windows Form Designer. 00022: 'Do not modify it using the code editor. 00023: <System.Diagnostics.DebuggerStepThrough()> _ 00024: Private Sub InitializeComponent() 00025: Me.components = New System.ComponentModel.Container 00026: Dim resources As System.ComponentModel.ComponentResourceManager = New System.ComponentModel.ComponentResourceManager(GetType(Main)) 00027: Me.FolderBrowserDialog1 = New System.Windows.Forms.FolderBrowserDialog 00028: Me.ToolStripContainer1 = New System.Windows.Forms.ToolStripContainer 00029: Me.SplitContainer1 = New System.Windows.Forms.SplitContainer 00030: Me.SplitContainer2 = New System.Windows.Forms.SplitContainer 00031: Me.T1 = New System.Windows.Forms.TreeView 00032: Me.ContextMenuStrip1 = New System.Windows.Forms.ContextMenuStrip(Me.components) 00033: Me.cmEdit = New System.Windows.Forms.ToolStripTextBox 00034: Me.cmNoRobot = New System.Windows.Forms.ToolStripTextBox 00035: Me.ImageList1 = New System.Windows.Forms.ImageList(Me.components) 00036: Me.TableLayoutPanel2 = New System.Windows.Forms.TableLayoutPanel 00037: Me.txFilter = New System.Windows.Forms.TextBox 00038: Me.btOpen = New System.Windows.Forms.Button 00039: Me.SplitContainer3 = New System.Windows.Forms.SplitContainer 00040: Me.SplitContainer6 = New System.Windows.Forms.SplitContainer 00041: Me.Label2 = New System.Windows.Forms.Label 00042: Me.Label1 = New System.Windows.Forms.Label 00043: Me.TableLayoutPanel1 = New System.Windows.Forms.TableLayoutPanel 00044: Me.txKey = New System.Windows.Forms.TextBox 00045: Me.txTitle = New System.Windows.Forms.TextBox 00046: Me.SplitContainer4 = New System.Windows.Forms.SplitContainer 00047: Me.SplitContainer5 = New System.Windows.Forms.SplitContainer 00048: Me.W1 = New System.Windows.Forms.WebBrowser 00049: Me.SplitContainer7 = New System.Windows.Forms.SplitContainer 00050: Me.G1 = New System.Windows.Forms.DataGridView 00051: Me.G2 = New System.Windows.Forms.DataGridView 00052: Me.FlowLayoutPanel1 = New System.Windows.Forms.FlowLayoutPanel 00053: Me.btSave = New System.Windows.Forms.Button 00054: Me.btSetFTP = New System.Windows.Forms.Button 00055: Me.btSaveFTP = New System.Windows.Forms.Button 00056: Me.btCheckLocal = New System.Windows.Forms.Button 00057: Me.btCheckInet = New System.Windows.Forms.Button 00058: Me.btViewLog = New System.Windows.Forms.Button 00059: Me.ToolStrip1 = New System.Windows.Forms.ToolStrip 00060: Me.ErrMsg = New System.Windows.Forms.ToolStripLabel 00061: Me.ProgressBar1 = New System.Windows.Forms.ToolStripProgressBar 00062: Me.ContextMenuStrip2 = New System.Windows.Forms.ContextMenuStrip(Me.components) 00063: Me.CopyToolStripMenuItem = New System.Windows.Forms.ToolStripMenuItem 00064: Me.ToolStripContainer1.ContentPanel.SuspendLayout() 00065: Me.ToolStripContainer1.TopToolStripPanel.SuspendLayout() 00066: Me.ToolStripContainer1.SuspendLayout() 00067: Me.SplitContainer1.Panel1.SuspendLayout() 00068: Me.SplitContainer1.Panel2.SuspendLayout() 00069: Me.SplitContainer1.SuspendLayout() 00070: Me.SplitContainer2.Panel1.SuspendLayout() 00071: Me.SplitContainer2.Panel2.SuspendLayout() 00072: Me.SplitContainer2.SuspendLayout() 00073: Me.ContextMenuStrip1.SuspendLayout() 00074: Me.TableLayoutPanel2.SuspendLayout() 00075: Me.SplitContainer3.Panel1.SuspendLayout() 00076: Me.SplitContainer3.Panel2.SuspendLayout() 00077: Me.SplitContainer3.SuspendLayout() 00078: Me.SplitContainer6.Panel1.SuspendLayout() 00079: Me.SplitContainer6.Panel2.SuspendLayout() 00080: Me.SplitContainer6.SuspendLayout() 00081: Me.TableLayoutPanel1.SuspendLayout() 00082: Me.SplitContainer4.Panel1.SuspendLayout() 00083: Me.SplitContainer4.Panel2.SuspendLayout() 00084: Me.SplitContainer4.SuspendLayout() 00085: Me.SplitContainer5.Panel1.SuspendLayout() 00086: Me.SplitContainer5.Panel2.SuspendLayout() 00087: Me.SplitContainer5.SuspendLayout() 00088: Me.SplitContainer7.Panel1.SuspendLayout() 00089: Me.SplitContainer7.Panel2.SuspendLayout() 00090: Me.SplitContainer7.SuspendLayout() 00091: CType(Me.G1, System.ComponentModel.ISupportInitialize).BeginInit() 00092: CType(Me.G2, System.ComponentModel.ISupportInitialize).BeginInit() 00093: Me.FlowLayoutPanel1.SuspendLayout() 00094: Me.ToolStrip1.SuspendLayout() 00095: Me.ContextMenuStrip2.SuspendLayout() 00096: Me.SuspendLayout() 00097: ' 00098: 'ToolStripContainer1 00099: ' 00100: ' 00101: 'ToolStripContainer1.ContentPanel 00102: ' 00103: Me.ToolStripContainer1.ContentPanel.Controls.Add(Me.SplitContainer1) 00104: Me.ToolStripContainer1.ContentPanel.Size = New System.Drawing.Size(824, 572) 00105: Me.ToolStripContainer1.Dock = System.Windows.Forms.DockStyle.Fill 00106: Me.ToolStripContainer1.Location = New System.Drawing.Point(0, 0) 00107: Me.ToolStripContainer1.Name = "ToolStripContainer1" 00108: Me.ToolStripContainer1.Size = New System.Drawing.Size(824, 597) 00109: Me.ToolStripContainer1.TabIndex = 0 00110: Me.ToolStripContainer1.Text = "ToolStripContainer1" 00111: ' 00112: 'ToolStripContainer1.TopToolStripPanel 00113: ' 00114: Me.ToolStripContainer1.TopToolStripPanel.Controls.Add(Me.ToolStrip1) 00115: ' 00116: 'SplitContainer1 00117: ' 00118: Me.SplitContainer1.Dock = System.Windows.Forms.DockStyle.Fill 00119: Me.SplitContainer1.Location = New System.Drawing.Point(0, 0) 00120: Me.SplitContainer1.Name = "SplitContainer1" 00121: ' 00122: 'SplitContainer1.Panel1 00123: ' 00124: Me.SplitContainer1.Panel1.Controls.Add(Me.SplitContainer2) 00125: ' 00126: 'SplitContainer1.Panel2 00127: ' 00128: Me.SplitContainer1.Panel2.Controls.Add(Me.SplitContainer3) 00129: Me.SplitContainer1.Size = New System.Drawing.Size(824, 572) 00130: Me.SplitContainer1.SplitterDistance = 217 00131: Me.SplitContainer1.TabIndex = 0 00132: ' 00133: 'SplitContainer2 00134: ' 00135: Me.SplitContainer2.Dock = System.Windows.Forms.DockStyle.Fill 00136: Me.SplitContainer2.FixedPanel = System.Windows.Forms.FixedPanel.Panel2 00137: Me.SplitContainer2.Location = New System.Drawing.Point(0, 0) 00138: Me.SplitContainer2.Name = "SplitContainer2" 00139: Me.SplitContainer2.Orientation = System.Windows.Forms.Orientation.Horizontal 00140: ' 00141: 'SplitContainer2.Panel1 00142: ' 00143: Me.SplitContainer2.Panel1.Controls.Add(Me.T1) 00144: ' 00145: 'SplitContainer2.Panel2 00146: ' 00147: Me.SplitContainer2.Panel2.Controls.Add(Me.TableLayoutPanel2) 00148: Me.SplitContainer2.Size = New System.Drawing.Size(217, 572) 00149: Me.SplitContainer2.SplitterDistance = 541 00150: Me.SplitContainer2.TabIndex = 0 00151: ' 00152: 'T1 00153: ' 00154: Me.T1.ContextMenuStrip = Me.ContextMenuStrip1 00155: Me.T1.Dock = System.Windows.Forms.DockStyle.Fill 00156: Me.T1.ImageIndex = 0 00157: Me.T1.ImageList = Me.ImageList1 00158: Me.T1.Location = New System.Drawing.Point(0, 0) 00159: Me.T1.Name = "T1" 00160: Me.T1.SelectedImageIndex = 2 00161: Me.T1.Size = New System.Drawing.Size(217, 541) 00162: Me.T1.TabIndex = 0 00163: ' 00164: 'ContextMenuStrip1 00165: ' 00166: Me.ContextMenuStrip1.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.cmEdit, Me.cmNoRobot}) 00167: Me.ContextMenuStrip1.Name = "ContextMenuStrip1" 00168: Me.ContextMenuStrip1.RenderMode = System.Windows.Forms.ToolStripRenderMode.System 00169: Me.ContextMenuStrip1.Size = New System.Drawing.Size(161, 36) 00170: ' 00171: 'cmEdit 00172: ' 00173: Me.cmEdit.BackColor = System.Drawing.SystemColors.Menu 00174: Me.cmEdit.BorderStyle = System.Windows.Forms.BorderStyle.None 00175: Me.cmEdit.Name = "cmEdit" 00176: Me.cmEdit.ReadOnly = True 00177: Me.cmEdit.Size = New System.Drawing.Size(100, 14) 00178: Me.cmEdit.Text = "Edit" 00179: Me.cmEdit.ToolTipText = "Редактировать файл" 00180: ' 00181: 'cmNoRobot 00182: ' 00183: Me.cmNoRobot.BackColor = System.Drawing.SystemColors.Menu 00184: Me.cmNoRobot.BorderStyle = System.Windows.Forms.BorderStyle.None 00185: Me.cmNoRobot.Name = "cmNoRobot" 00186: Me.cmNoRobot.ReadOnly = True 00187: Me.cmNoRobot.Size = New System.Drawing.Size(100, 14) 00188: Me.cmNoRobot.Text = "NoIndex" 00189: Me.cmNoRobot.ToolTipText = "Не индексировать в поисковых машинах" 00190: ' 00191: 'ImageList1 00192: ' 00193: Me.ImageList1.ImageStream = CType(resources.GetObject("ImageList1.ImageStream"), System.Windows.Forms.ImageListStreamer) 00194: Me.ImageList1.TransparentColor = System.Drawing.Color.Transparent 00195: Me.ImageList1.Images.SetKeyName(0, "") 00196: Me.ImageList1.Images.SetKeyName(1, "") 00197: Me.ImageList1.Images.SetKeyName(2, "i51.ico") 00198: ' 00199: 'TableLayoutPanel2 00200: ' 00201: Me.TableLayoutPanel2.ColumnCount = 2 00202: Me.TableLayoutPanel2.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 25.80645!)) 00203: Me.TableLayoutPanel2.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 74.19355!)) 00204: Me.TableLayoutPanel2.Controls.Add(Me.txFilter, 0, 0) 00205: Me.TableLayoutPanel2.Controls.Add(Me.btOpen, 1, 0) 00206: Me.TableLayoutPanel2.Dock = System.Windows.Forms.DockStyle.Fill 00207: Me.TableLayoutPanel2.Location = New System.Drawing.Point(0, 0) 00208: Me.TableLayoutPanel2.Name = "TableLayoutPanel2" 00209: Me.TableLayoutPanel2.RowCount = 1 00210: Me.TableLayoutPanel2.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!)) 00211: Me.TableLayoutPanel2.Size = New System.Drawing.Size(217, 27) 00212: Me.TableLayoutPanel2.TabIndex = 2 00213: ' 00214: 'txFilter 00215: ' 00216: Me.txFilter.Dock = System.Windows.Forms.DockStyle.Left 00217: Me.txFilter.Location = New System.Drawing.Point(3, 3) 00218: Me.txFilter.Name = "txFilter" 00219: Me.txFilter.Size = New System.Drawing.Size(40, 20) 00220: Me.txFilter.TabIndex = 2 00221: Me.txFilter.Text = "*.htm*" 00222: ' 00223: 'btOpen 00224: ' 00225: Me.btOpen.Location = New System.Drawing.Point(58, 3) 00226: Me.btOpen.Name = "btOpen" 00227: Me.btOpen.Size = New System.Drawing.Size(75, 21) 00228: Me.btOpen.TabIndex = 1 00229: Me.btOpen.Text = "OpenLocal" 00230: Me.btOpen.UseVisualStyleBackColor = True 00231: ' 00232: 'SplitContainer3 00233: ' 00234: Me.SplitContainer3.Dock = System.Windows.Forms.DockStyle.Fill 00235: Me.SplitContainer3.FixedPanel = System.Windows.Forms.FixedPanel.Panel1 00236: Me.SplitContainer3.Location = New System.Drawing.Point(0, 0) 00237: Me.SplitContainer3.Name = "SplitContainer3" 00238: Me.SplitContainer3.Orientation = System.Windows.Forms.Orientation.Horizontal 00239: ' 00240: 'SplitContainer3.Panel1 00241: ' 00242: Me.SplitContainer3.Panel1.Controls.Add(Me.SplitContainer6) 00243: ' 00244: 'SplitContainer3.Panel2 00245: ' 00246: Me.SplitContainer3.Panel2.Controls.Add(Me.SplitContainer4) 00247: Me.SplitContainer3.Size = New System.Drawing.Size(603, 572) 00248: Me.SplitContainer3.SplitterDistance = 60 00249: Me.SplitContainer3.TabIndex = 0 00250: ' 00251: 'SplitContainer6 00252: ' 00253: Me.SplitContainer6.Dock = System.Windows.Forms.DockStyle.Fill 00254: Me.SplitContainer6.FixedPanel = System.Windows.Forms.FixedPanel.Panel1 00255: Me.SplitContainer6.Location = New System.Drawing.Point(0, 0) 00256: Me.SplitContainer6.Name = "SplitContainer6" 00257: ' 00258: 'SplitContainer6.Panel1 00259: ' 00260: Me.SplitContainer6.Panel1.Controls.Add(Me.Label2) 00261: Me.SplitContainer6.Panel1.Controls.Add(Me.Label1) 00262: ' 00263: 'SplitContainer6.Panel2 00264: ' 00265: Me.SplitContainer6.Panel2.Controls.Add(Me.TableLayoutPanel1) 00266: Me.SplitContainer6.Size = New System.Drawing.Size(603, 60) 00267: Me.SplitContainer6.SplitterDistance = 68 00268: Me.SplitContainer6.TabIndex = 4 00269: ' 00270: 'Label2 00271: ' 00272: Me.Label2.AutoSize = True 00273: Me.Label2.Location = New System.Drawing.Point(3, 32) 00274: Me.Label2.Name = "Label2" 00275: Me.Label2.Size = New System.Drawing.Size(56, 13) 00276: Me.Label2.TabIndex = 2 00277: Me.Label2.Text = "KeyWords" 00278: ' 00279: 'Label1 00280: ' 00281: Me.Label1.AutoSize = True 00282: Me.Label1.Location = New System.Drawing.Point(3, 6) 00283: Me.Label1.Name = "Label1" 00284: Me.Label1.Size = New System.Drawing.Size(27, 13) 00285: Me.Label1.TabIndex = 0 00286: Me.Label1.Text = "Title" 00287: ' 00288: 'TableLayoutPanel1 00289: ' 00290: Me.TableLayoutPanel1.ColumnCount = 1 00291: Me.TableLayoutPanel1.ColumnStyles.Add(New System.Windows.Forms.ColumnStyle(System.Windows.Forms.SizeType.Percent, 50.0!)) 00292: Me.TableLayoutPanel1.Controls.Add(Me.txKey, 0, 1) 00293: Me.TableLayoutPanel1.Controls.Add(Me.txTitle, 0, 0) 00294: Me.TableLayoutPanel1.Dock = System.Windows.Forms.DockStyle.Fill 00295: Me.TableLayoutPanel1.Location = New System.Drawing.Point(0, 0) 00296: Me.TableLayoutPanel1.Name = "TableLayoutPanel1" 00297: Me.TableLayoutPanel1.RowCount = 2 00298: Me.TableLayoutPanel1.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!)) 00299: Me.TableLayoutPanel1.RowStyles.Add(New System.Windows.Forms.RowStyle(System.Windows.Forms.SizeType.Percent, 50.0!)) 00300: Me.TableLayoutPanel1.Size = New System.Drawing.Size(531, 60) 00301: Me.TableLayoutPanel1.TabIndex = 0 00302: ' 00303: 'txKey 00304: ' 00305: Me.txKey.Dock = System.Windows.Forms.DockStyle.Fill 00306: Me.txKey.Location = New System.Drawing.Point(3, 33) 00307: Me.txKey.Name = "txKey" 00308: Me.txKey.Size = New System.Drawing.Size(525, 20) 00309: Me.txKey.TabIndex = 4 00310: ' 00311: 'txTitle 00312: ' 00313: Me.txTitle.Dock = System.Windows.Forms.DockStyle.Fill 00314: Me.txTitle.Location = New System.Drawing.Point(3, 3) 00315: Me.txTitle.Name = "txTitle" 00316: Me.txTitle.Size = New System.Drawing.Size(525, 20) 00317: Me.txTitle.TabIndex = 1 00318: ' 00319: 'SplitContainer4 00320: ' 00321: Me.SplitContainer4.Dock = System.Windows.Forms.DockStyle.Fill 00322: Me.SplitContainer4.FixedPanel = System.Windows.Forms.FixedPanel.Panel2 00323: Me.SplitContainer4.Location = New System.Drawing.Point(0, 0) 00324: Me.SplitContainer4.Name = "SplitContainer4" 00325: Me.SplitContainer4.Orientation = System.Windows.Forms.Orientation.Horizontal 00326: ' 00327: 'SplitContainer4.Panel1 00328: ' 00329: Me.SplitContainer4.Panel1.Controls.Add(Me.SplitContainer5) 00330: ' 00331: 'SplitContainer4.Panel2 00332: ' 00333: Me.SplitContainer4.Panel2.Controls.Add(Me.FlowLayoutPanel1) 00334: Me.SplitContainer4.Size = New System.Drawing.Size(603, 508) 00335: Me.SplitContainer4.SplitterDistance = 479 00336: Me.SplitContainer4.TabIndex = 0 00337: ' 00338: 'SplitContainer5 00339: ' 00340: Me.SplitContainer5.Dock = System.Windows.Forms.DockStyle.Fill 00341: Me.SplitContainer5.Location = New System.Drawing.Point(0, 0) 00342: Me.SplitContainer5.Name = "SplitContainer5" 00343: Me.SplitContainer5.Orientation = System.Windows.Forms.Orientation.Horizontal 00344: ' 00345: 'SplitContainer5.Panel1 00346: ' 00347: Me.SplitContainer5.Panel1.Controls.Add(Me.W1) 00348: ' 00349: 'SplitContainer5.Panel2 00350: ' 00351: Me.SplitContainer5.Panel2.Controls.Add(Me.SplitContainer7) 00352: Me.SplitContainer5.Size = New System.Drawing.Size(603, 479) 00353: Me.SplitContainer5.SplitterDistance = 353 00354: Me.SplitContainer5.TabIndex = 1 00355: ' 00356: 'W1 00357: ' 00358: Me.W1.Dock = System.Windows.Forms.DockStyle.Fill 00359: Me.W1.Location = New System.Drawing.Point(0, 0) 00360: Me.W1.MinimumSize = New System.Drawing.Size(20, 20) 00361: Me.W1.Name = "W1" 00362: Me.W1.Size = New System.Drawing.Size(603, 353) 00363: Me.W1.TabIndex = 0 00364: ' 00365: 'SplitContainer7 00366: ' 00367: Me.SplitContainer7.Dock = System.Windows.Forms.DockStyle.Fill 00368: Me.SplitContainer7.Location = New System.Drawing.Point(0, 0) 00369: Me.SplitContainer7.Name = "SplitContainer7" 00370: Me.SplitContainer7.Orientation = System.Windows.Forms.Orientation.Horizontal 00371: ' 00372: 'SplitContainer7.Panel1 00373: ' 00374: Me.SplitContainer7.Panel1.Controls.Add(Me.G1) 00375: ' 00376: 'SplitContainer7.Panel2 00377: ' 00378: Me.SplitContainer7.Panel2.Controls.Add(Me.G2) 00379: Me.SplitContainer7.Size = New System.Drawing.Size(603, 122) 00380: Me.SplitContainer7.SplitterDistance = 60 00381: Me.SplitContainer7.TabIndex = 1 00382: ' 00383: 'G1 00384: ' 00385: Me.G1.AutoSizeColumnsMode = System.Windows.Forms.DataGridViewAutoSizeColumnsMode.Fill 00386: Me.G1.ColumnHeadersHeightSizeMode = System.Windows.Forms.DataGridViewColumnHeadersHeightSizeMode.AutoSize 00387: Me.G1.Dock = System.Windows.Forms.DockStyle.Fill 00388: Me.G1.Location = New System.Drawing.Point(0, 0) 00389: Me.G1.MultiSelect = False 00390: Me.G1.Name = "G1" 00391: Me.G1.RowTemplate.Height = 18 00392: Me.G1.Size = New System.Drawing.Size(603, 60) 00393: Me.G1.TabIndex = 0 00394: ' 00395: 'G2 00396: ' 00397: Me.G2.AutoSizeColumnsMode = System.Windows.Forms.DataGridViewAutoSizeColumnsMode.Fill 00398: Me.G2.ColumnHeadersHeightSizeMode = System.Windows.Forms.DataGridViewColumnHeadersHeightSizeMode.AutoSize 00399: Me.G2.Dock = System.Windows.Forms.DockStyle.Fill 00400: Me.G2.Location = New System.Drawing.Point(0, 0) 00401: Me.G2.Name = "G2" 00402: Me.G2.Size = New System.Drawing.Size(603, 58) 00403: Me.G2.TabIndex = 0 00404: ' 00405: 'FlowLayoutPanel1 00406: ' 00407: Me.FlowLayoutPanel1.Controls.Add(Me.btSave) 00408: Me.FlowLayoutPanel1.Controls.Add(Me.btSetFTP) 00409: Me.FlowLayoutPanel1.Controls.Add(Me.btSaveFTP) 00410: Me.FlowLayoutPanel1.Controls.Add(Me.btCheckLocal) 00411: Me.FlowLayoutPanel1.Controls.Add(Me.btCheckInet) 00412: Me.FlowLayoutPanel1.Controls.Add(Me.btViewLog) 00413: Me.FlowLayoutPanel1.Dock = System.Windows.Forms.DockStyle.Fill 00414: Me.FlowLayoutPanel1.Location = New System.Drawing.Point(0, 0) 00415: Me.FlowLayoutPanel1.Name = "FlowLayoutPanel1" 00416: Me.FlowLayoutPanel1.Size = New System.Drawing.Size(603, 25) 00417: Me.FlowLayoutPanel1.TabIndex = 0 00418: ' 00419: 'btSave 00420: ' 00421: Me.btSave.Anchor = System.Windows.Forms.AnchorStyles.Bottom 00422: Me.btSave.Enabled = False 00423: Me.btSave.Location = New System.Drawing.Point(3, 3) 00424: Me.btSave.Name = "btSave" 00425: Me.btSave.Size = New System.Drawing.Size(75, 23) 00426: Me.btSave.TabIndex = 5 00427: Me.btSave.Text = "SaveLocal" 00428: Me.btSave.UseVisualStyleBackColor = True 00429: ' 00430: 'btSetFTP 00431: ' 00432: Me.btSetFTP.Anchor = System.Windows.Forms.AnchorStyles.Bottom 00433: Me.btSetFTP.Enabled = False 00434: Me.btSetFTP.Location = New System.Drawing.Point(84, 3) 00435: Me.btSetFTP.Name = "btSetFTP" 00436: Me.btSetFTP.Size = New System.Drawing.Size(75, 23) 00437: Me.btSetFTP.TabIndex = 8 00438: Me.btSetFTP.Text = "SetFTP" 00439: Me.btSetFTP.UseVisualStyleBackColor = True 00440: ' 00441: 'btSaveFTP 00442: ' 00443: Me.btSaveFTP.Anchor = System.Windows.Forms.AnchorStyles.Bottom 00444: Me.btSaveFTP.Enabled = False 00445: Me.btSaveFTP.Location = New System.Drawing.Point(165, 3) 00446: Me.btSaveFTP.Name = "btSaveFTP" 00447: Me.btSaveFTP.Size = New System.Drawing.Size(75, 23) 00448: Me.btSaveFTP.TabIndex = 7 00449: Me.btSaveFTP.Text = "SaveFTP" 00450: Me.btSaveFTP.UseVisualStyleBackColor = True 00451: ' 00452: 'btCheckLocal 00453: ' 00454: Me.btCheckLocal.Anchor = System.Windows.Forms.AnchorStyles.Bottom 00455: Me.btCheckLocal.Enabled = False 00456: Me.btCheckLocal.Location = New System.Drawing.Point(246, 3) 00457: Me.btCheckLocal.Name = "btCheckLocal" 00458: Me.btCheckLocal.Size = New System.Drawing.Size(75, 23) 00459: Me.btCheckLocal.TabIndex = 6 00460: Me.btCheckLocal.Text = "CheckLocal" 00461: Me.btCheckLocal.UseVisualStyleBackColor = True 00462: ' 00463: 'btCheckInet 00464: ' 00465: Me.btCheckInet.Anchor = System.Windows.Forms.AnchorStyles.Bottom 00466: Me.btCheckInet.Enabled = False 00467: Me.btCheckInet.Location = New System.Drawing.Point(327, 3) 00468: Me.btCheckInet.Name = "btCheckInet" 00469: Me.btCheckInet.Size = New System.Drawing.Size(75, 23) 00470: Me.btCheckInet.TabIndex = 10 00471: Me.btCheckInet.Text = "CheckInet" 00472: Me.btCheckInet.UseVisualStyleBackColor = True 00473: ' 00474: 'btViewLog 00475: ' 00476: Me.btViewLog.Anchor = System.Windows.Forms.AnchorStyles.Bottom 00477: Me.btViewLog.Enabled = False 00478: Me.btViewLog.Location = New System.Drawing.Point(408, 3) 00479: Me.btViewLog.Name = "btViewLog" 00480: Me.btViewLog.Size = New System.Drawing.Size(75, 23) 00481: Me.btViewLog.TabIndex = 9 00482: Me.btViewLog.Text = "SaveIndex" 00483: Me.btViewLog.UseVisualStyleBackColor = True 00484: ' 00485: 'ToolStrip1 00486: ' 00487: Me.ToolStrip1.Dock = System.Windows.Forms.DockStyle.None 00488: Me.ToolStrip1.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.ErrMsg, Me.ProgressBar1}) 00489: Me.ToolStrip1.Location = New System.Drawing.Point(3, 0) 00490: Me.ToolStrip1.Name = "ToolStrip1" 00491: Me.ToolStrip1.Size = New System.Drawing.Size(143, 25) 00492: Me.ToolStrip1.TabIndex = 0 00493: ' 00494: 'ErrMsg 00495: ' 00496: Me.ErrMsg.Name = "ErrMsg" 00497: Me.ErrMsg.Size = New System.Drawing.Size(0, 22) 00498: ' 00499: 'ProgressBar1 00500: ' 00501: Me.ProgressBar1.Name = "ProgressBar1" 00502: Me.ProgressBar1.Size = New System.Drawing.Size(100, 22) 00503: Me.ProgressBar1.Visible = False 00504: ' 00505: 'ContextMenuStrip2 00506: ' 00507: Me.ContextMenuStrip2.Items.AddRange(New System.Windows.Forms.ToolStripItem() {Me.CopyToolStripMenuItem}) 00508: Me.ContextMenuStrip2.Name = "ContextMenuStrip2" 00509: Me.ContextMenuStrip2.Size = New System.Drawing.Size(111, 26) 00510: ' 00511: 'CopyToolStripMenuItem 00512: ' 00513: Me.CopyToolStripMenuItem.Name = "CopyToolStripMenuItem" 00514: Me.CopyToolStripMenuItem.Size = New System.Drawing.Size(110, 22) 00515: Me.CopyToolStripMenuItem.Text = "Copy" 00516: ' 00517: 'Main 00518: ' 00519: Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) 00520: Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font 00521: Me.ClientSize = New System.Drawing.Size(824, 597) 00522: Me.Controls.Add(Me.ToolStripContainer1) 00523: Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon) 00524: Me.Name = "Main" 00525: Me.Text = "Сайт " 00526: Me.ToolStripContainer1.ContentPanel.ResumeLayout(False) 00527: Me.ToolStripContainer1.TopToolStripPanel.ResumeLayout(False) 00528: Me.ToolStripContainer1.TopToolStripPanel.PerformLayout() 00529: Me.ToolStripContainer1.ResumeLayout(False) 00530: Me.ToolStripContainer1.PerformLayout() 00531: Me.SplitContainer1.Panel1.ResumeLayout(False) 00532: Me.SplitContainer1.Panel2.ResumeLayout(False) 00533: Me.SplitContainer1.ResumeLayout(False) 00534: Me.SplitContainer2.Panel1.ResumeLayout(False) 00535: Me.SplitContainer2.Panel2.ResumeLayout(False) 00536: Me.SplitContainer2.ResumeLayout(False) 00537: Me.ContextMenuStrip1.ResumeLayout(False) 00538: Me.ContextMenuStrip1.PerformLayout() 00539: Me.TableLayoutPanel2.ResumeLayout(False) 00540: Me.TableLayoutPanel2.PerformLayout() 00541: Me.SplitContainer3.Panel1.ResumeLayout(False) 00542: Me.SplitContainer3.Panel2.ResumeLayout(False) 00543: Me.SplitContainer3.ResumeLayout(False) 00544: Me.SplitContainer6.Panel1.ResumeLayout(False) 00545: Me.SplitContainer6.Panel1.PerformLayout() 00546: Me.SplitContainer6.Panel2.ResumeLayout(False) 00547: Me.SplitContainer6.ResumeLayout(False) 00548: Me.TableLayoutPanel1.ResumeLayout(False) 00549: Me.TableLayoutPanel1.PerformLayout() 00550: Me.SplitContainer4.Panel1.ResumeLayout(False) 00551: Me.SplitContainer4.Panel2.ResumeLayout(False) 00552: Me.SplitContainer4.ResumeLayout(False) 00553: Me.SplitContainer5.Panel1.ResumeLayout(False) 00554: Me.SplitContainer5.Panel2.ResumeLayout(False) 00555: Me.SplitContainer5.ResumeLayout(False) 00556: Me.SplitContainer7.Panel1.ResumeLayout(False) 00557: Me.SplitContainer7.Panel2.ResumeLayout(False) 00558: Me.SplitContainer7.ResumeLayout(False) 00559: CType(Me.G1, System.ComponentModel.ISupportInitialize).EndInit() 00560: CType(Me.G2, System.ComponentModel.ISupportInitialize).EndInit() 00561: Me.FlowLayoutPanel1.ResumeLayout(False) 00562: Me.ToolStrip1.ResumeLayout(False) 00563: Me.ToolStrip1.PerformLayout() 00564: Me.ContextMenuStrip2.ResumeLayout(False) 00565: Me.ResumeLayout(False) 00566: 00567: End Sub 00568: Friend WithEvents FolderBrowserDialog1 As System.Windows.Forms.FolderBrowserDialog 00569: Friend WithEvents ToolStripContainer1 As System.Windows.Forms.ToolStripContainer 00570: Friend WithEvents SplitContainer1 As System.Windows.Forms.SplitContainer 00571: Friend WithEvents SplitContainer2 As System.Windows.Forms.SplitContainer 00572: Friend WithEvents SplitContainer3 As System.Windows.Forms.SplitContainer 00573: Friend WithEvents SplitContainer4 As System.Windows.Forms.SplitContainer 00574: Friend WithEvents Label2 As System.Windows.Forms.Label 00575: Friend WithEvents txTitle As System.Windows.Forms.TextBox 00576: Friend WithEvents Label1 As System.Windows.Forms.Label 00577: Friend WithEvents SplitContainer5 As System.Windows.Forms.SplitContainer 00578: Friend WithEvents W1 As System.Windows.Forms.WebBrowser 00579: Friend WithEvents G1 As System.Windows.Forms.DataGridView 00580: Friend WithEvents FlowLayoutPanel1 As System.Windows.Forms.FlowLayoutPanel 00581: Friend WithEvents btViewLog As System.Windows.Forms.Button 00582: Friend WithEvents btSetFTP As System.Windows.Forms.Button 00583: Friend WithEvents btSaveFTP As System.Windows.Forms.Button 00584: Friend WithEvents btCheckLocal As System.Windows.Forms.Button 00585: Friend WithEvents btSave As System.Windows.Forms.Button 00586: Friend WithEvents ImageList1 As System.Windows.Forms.ImageList 00587: Friend WithEvents SplitContainer6 As System.Windows.Forms.SplitContainer 00588: Friend WithEvents TableLayoutPanel1 As System.Windows.Forms.TableLayoutPanel 00589: Friend WithEvents txKey As System.Windows.Forms.TextBox 00590: Friend WithEvents TableLayoutPanel2 As System.Windows.Forms.TableLayoutPanel 00591: Friend WithEvents txFilter As System.Windows.Forms.TextBox 00592: Friend WithEvents btOpen As System.Windows.Forms.Button 00593: Friend WithEvents btCheckInet As System.Windows.Forms.Button 00594: Friend WithEvents ContextMenuStrip1 As System.Windows.Forms.ContextMenuStrip 00595: Friend WithEvents cmEdit As System.Windows.Forms.ToolStripTextBox 00596: Friend WithEvents cmNoRobot As System.Windows.Forms.ToolStripTextBox 00597: Friend WithEvents T1 As System.Windows.Forms.TreeView 00598: Friend WithEvents SplitContainer7 As System.Windows.Forms.SplitContainer 00599: Friend WithEvents G2 As System.Windows.Forms.DataGridView 00600: Friend WithEvents ContextMenuStrip2 As System.Windows.Forms.ContextMenuStrip 00601: Friend WithEvents CopyToolStripMenuItem As System.Windows.Forms.ToolStripMenuItem 00602: Friend WithEvents ToolStrip1 As System.Windows.Forms.ToolStrip 00603: Friend WithEvents ErrMsg As System.Windows.Forms.ToolStripLabel 00604: Friend WithEvents ProgressBar1 As System.Windows.Forms.ToolStripProgressBar 00605: 00606: End Class
Далее я покажу текст маленькой формы для регистрации доступа к FTP и ее текст.
00001: <Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _ 00002: Partial Class LoginFTP 00003: Inherits System.Windows.Forms.Form 00004: 00005: 'Form overrides dispose to clean up the component list. 00006: <System.Diagnostics.DebuggerNonUserCode()> _ 00007: Protected Overrides Sub Dispose(ByVal disposing As Boolean) 00008: Try 00009: If disposing AndAlso components IsNot Nothing Then 00010: components.Dispose() 00011: End If 00012: Finally 00013: MyBase.Dispose(disposing) 00014: End Try 00015: End Sub 00016: 00017: 'Required by the Windows Form Designer 00018: Private components As System.ComponentModel.IContainer 00019: 00020: 'NOTE: The following procedure is required by the Windows Form Designer 00021: 'It can be modified using the Windows Form Designer. 00022: 'Do not modify it using the code editor. 00023: <System.Diagnostics.DebuggerStepThrough()> _ 00024: Private Sub InitializeComponent() 00025: Me.Label1 = New System.Windows.Forms.Label 00026: Me.TextBox1 = New System.Windows.Forms.TextBox 00027: Me.Label2 = New System.Windows.Forms.Label 00028: Me.Label3 = New System.Windows.Forms.Label 00029: Me.TextBox2 = New System.Windows.Forms.TextBox 00030: Me.TextBox3 = New System.Windows.Forms.TextBox 00031: Me.Button1 = New System.Windows.Forms.Button 00032: Me.Label4 = New System.Windows.Forms.Label 00033: Me.txTimeout = New System.Windows.Forms.MaskedTextBox 00034: Me.SuspendLayout() 00035: ' 00036: 'Label1 00037: ' 00038: Me.Label1.AutoSize = True 00039: Me.Label1.Location = New System.Drawing.Point(13, 13) 00040: Me.Label1.Name = "Label1" 00041: Me.Label1.Size = New System.Drawing.Size(44, 13) 00042: Me.Label1.TabIndex = 0 00043: Me.Label1.Text = "Сервер" 00044: ' 00045: 'TextBox1 00046: ' 00047: Me.TextBox1.Location = New System.Drawing.Point(84, 5) 00048: Me.TextBox1.MaxLength = 100 00049: Me.TextBox1.Name = "TextBox1" 00050: Me.TextBox1.Size = New System.Drawing.Size(183, 20) 00051: Me.TextBox1.TabIndex = 1 00052: ' 00053: 'Label2 00054: ' 00055: Me.Label2.AutoSize = True 00056: Me.Label2.Location = New System.Drawing.Point(13, 42) 00057: Me.Label2.Name = "Label2" 00058: Me.Label2.Size = New System.Drawing.Size(33, 13) 00059: Me.Label2.TabIndex = 2 00060: Me.Label2.Text = "Login" 00061: ' 00062: 'Label3 00063: ' 00064: Me.Label3.AutoSize = True 00065: Me.Label3.Location = New System.Drawing.Point(13, 71) 00066: Me.Label3.Name = "Label3" 00067: Me.Label3.Size = New System.Drawing.Size(53, 13) 00068: Me.Label3.TabIndex = 3 00069: Me.Label3.Text = "Password" 00070: ' 00071: 'TextBox2 00072: ' 00073: Me.TextBox2.Location = New System.Drawing.Point(84, 34) 00074: Me.TextBox2.MaxLength = 100 00075: Me.TextBox2.Name = "TextBox2" 00076: Me.TextBox2.Size = New System.Drawing.Size(183, 20) 00077: Me.TextBox2.TabIndex = 2 00078: ' 00079: 'TextBox3 00080: ' 00081: Me.TextBox3.Location = New System.Drawing.Point(84, 63) 00082: Me.TextBox3.MaxLength = 16 00083: Me.TextBox3.Name = "TextBox3" 00084: Me.TextBox3.Size = New System.Drawing.Size(183, 20) 00085: Me.TextBox3.TabIndex = 3 00086: Me.TextBox3.UseSystemPasswordChar = True 00087: ' 00088: 'Button1 00089: ' 00090: Me.Button1.Location = New System.Drawing.Point(193, 98) 00091: Me.Button1.Name = "Button1" 00092: Me.Button1.Size = New System.Drawing.Size(74, 23) 00093: Me.Button1.TabIndex = 5 00094: Me.Button1.Text = "OK" 00095: Me.Button1.UseVisualStyleBackColor = True 00096: ' 00097: 'Label4 00098: ' 00099: Me.Label4.AutoSize = True 00100: Me.Label4.Location = New System.Drawing.Point(13, 103) 00101: Me.Label4.Name = "Label4" 00102: Me.Label4.Size = New System.Drawing.Size(60, 13) 00103: Me.Label4.TabIndex = 7 00104: Me.Label4.Text = "Timeout (c)" 00105: ' 00106: 'txTimeout 00107: ' 00108: Me.txTimeout.Location = New System.Drawing.Point(84, 95) 00109: Me.txTimeout.Mask = "00" 00110: Me.txTimeout.Name = "txTimeout" 00111: Me.txTimeout.Size = New System.Drawing.Size(35, 20) 00112: Me.txTimeout.TabIndex = 4 00113: ' 00114: 'LoginFTP 00115: ' 00116: Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!) 00117: Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font 00118: Me.ClientSize = New System.Drawing.Size(295, 136) 00119: Me.Controls.Add(Me.txTimeout) 00120: Me.Controls.Add(Me.Label4) 00121: Me.Controls.Add(Me.Button1) 00122: Me.Controls.Add(Me.TextBox3) 00123: Me.Controls.Add(Me.TextBox2) 00124: Me.Controls.Add(Me.Label3) 00125: Me.Controls.Add(Me.Label2) 00126: Me.Controls.Add(Me.TextBox1) 00127: Me.Controls.Add(Me.Label1) 00128: Me.MaximizeBox = False 00129: Me.MinimizeBox = False 00130: Me.Name = "LoginFTP" 00131: Me.Text = "LoginFTP" 00132: Me.ResumeLayout(False) 00133: Me.PerformLayout() 00134: 00135: End Sub 00136: Friend WithEvents Label1 As System.Windows.Forms.Label 00137: Friend WithEvents TextBox1 As System.Windows.Forms.TextBox 00138: Friend WithEvents Label2 As System.Windows.Forms.Label 00139: Friend WithEvents Label3 As System.Windows.Forms.Label 00140: Friend WithEvents TextBox2 As System.Windows.Forms.TextBox 00141: Friend WithEvents TextBox3 As System.Windows.Forms.TextBox 00142: Friend WithEvents Button1 As System.Windows.Forms.Button 00143: Friend WithEvents Label4 As System.Windows.Forms.Label 00144: Friend WithEvents txTimeout As System.Windows.Forms.MaskedTextBox 00145: End Class 00001: Public Class LoginFTP 00002: 00003: Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 00004: Using LM As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE", True) 00005: Using VBN As Microsoft.Win32.RegistryKey = LM.CreateSubKey("VBNET2000") 00006: VBN.SetValue("FTP_Server", TextBox1.Text) 00007: VBN.SetValue("FTP_Login", TextBox2.Text) 00008: VBN.SetValue("FTP_Timeout", CInt(txTimeout.Text)) 00009: VBN.SetValue("FTP_Password", Crypt.SecurePass16(TextBox3.Text)) 00010: End Using 00011: End Using 00012: Me.Close() 00013: End Sub 00014: 00015: Private Sub LoginFTP_Activated(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Activated 00016: TextBox3.Focus() 00017: End Sub 00018: 00019: Private Sub LoginFTP_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load 00020: Using LM As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE", False) 00021: Using VBN As Microsoft.Win32.RegistryKey = LM.OpenSubKey("VBNET2000") 00022: If VBN IsNot Nothing Then 00023: TextBox1.Text = VBN.GetValue("FTP_Server").ToString 00024: TextBox2.Text = VBN.GetValue("FTP_Login").ToString 00025: txTimeout.Text = CInt(VBN.GetValue("FTP_Timeout")).ToString 00026: End If 00027: End Using 00028: End Using 00029: End Sub 00030: End Class
Как видите, пока все предельно бесхитростно и ни в каких комментариях не нуждается. Форма регистрации запоминает введенные вами логины и пароли в реестре, откуда их читает главная форма. Хотя...Неужели я бы стал писать пароль в реестр открытым текстом? Нет конечно. Поэтому в проге присутсвует небольшой криптографический модуль. Увы, комментировать его работу я не буду, ибо работу криптографии я не комментирую. Думаю программисту достаточно лишь взглянуть на текст, чтобы понять вариант, которые я выбрал для хранения закрытого ключа шифрования. Ну а посторонним это не надо. Этим модулем можно просто пользоваться "как есть".
00001: Public Class Crypt 00002: 00003: ''' <summary> 00004: ''' Расшифровать пароль 00005: ''' Если пароль шифровался без инициализирующего вектора, то при расшифровке этот вектор задавать не следует 00006: ''' </summary> 00007: ''' <param name="SecureBytes">SecureBytes(32) as byte</param> 00008: ''' <param name="IniVector">Специально заданный модификатор ключа шифрования</param> 00009: ''' <returns>Расшифрованный пароль</returns> 00010: ''' <remarks>Rijndael Simmetric algoritm</remarks> 00011: Friend Shared Function UnSecurePass16(ByVal SecureBytes As Byte(), ByVal IniVector As String) As String 00012: If SecureBytes.Length <> 32 Then 00013: Throw New Exception("Неверный размер зашифрованных данных.") 00014: End If 00015: Dim Rijndael As Security.Cryptography.RijndaelManaged = CType(Security.Cryptography.RijndaelManaged.Create, Security.Cryptography.RijndaelManaged) 00016: Rijndael.BlockSize = SecureBytes.Length * 8 00017: Return UnSecure(Rijndael, SecureBytes, IniVector, Rijndael.BlockSize) 00018: End Function 00019: 00020: ''' <summary> 00021: ''' Расшифровать пароль 00022: ''' Если пароль шифровался без инициализирующего вектора, то при расшифровке этот вектор задавать не следует 00023: ''' </summary> 00024: ''' <param name="SecureBytes">SecureBytes(32) as byte</param> 00025: ''' <returns>Расшифрованный пароль</returns> 00026: ''' <remarks>Rijndael Simmetric algoritm</remarks> 00027: Friend Shared Function UnSecurePass16(ByVal SecureBytes As Byte()) As String 00028: If SecureBytes.Length <> 32 Then 00029: Throw New Exception("Неверный размер зашифрованных данных.") 00030: End If 00031: Dim Rijndael As Security.Cryptography.RijndaelManaged = CType(Security.Cryptography.RijndaelManaged.Create, Security.Cryptography.RijndaelManaged) 00032: Rijndael.BlockSize = SecureBytes.Length * 8 00033: Return UnSecure(Rijndael, SecureBytes, My.Application.Info.AssemblyName & My.Application.Info.Copyright, Rijndael.BlockSize) 00034: End Function 00035: 00036: Private Shared Function UnSecure(ByVal Rijndael As Security.Cryptography.RijndaelManaged, ByVal SecureBytes As Byte(), ByVal IniVector As String, ByVal BlockSize As Integer) As String 00037: Dim BufSize As Integer = CInt(Rijndael.BlockSize / 8) - 1 00038: Dim OutBuf(BufSize) As Byte 00039: Dim IV(BufSize) As Byte 00040: Dim Key(CInt(Rijndael.LegalKeySizes(0).MaxSize / 8) - 1) As Byte 00041: ' 00042: Dim Tmp() As Byte = GetKey(IniVector) 00043: For i As Integer = 0 To Math.Min(UBound(IV), UBound(Tmp)) 00044: IV(i) = Tmp(i) 00045: Next 00046: For i As Integer = 0 To Math.Min(UBound(Key), UBound(Tmp)) 00047: Key(i) = Tmp(i) 00048: Next 00049: ' 00050: Dim Encriptor = Rijndael.CreateDecryptor(Key, IV) 00051: Encriptor.TransformBlock(SecureBytes, CInt(0), SecureBytes.Length, OutBuf, CInt(0)) 00052: ' 00053: 'Здесь баг - приходится вызывать ДВА РАЗА - так быть НЕ ДОЛЖНО !!! 00054: ' 00055: If Encriptor.TransformBlock(SecureBytes, CInt(0), SecureBytes.Length, OutBuf, CInt(0)) = 0 Then 00056: Throw New Exception("Дешифрование не выполнено.") 00057: Exit Function 00058: End If 00059: ' 00060: Dim Encoder As New System.Text.UnicodeEncoding 00061: Return Encoder.GetString(OutBuf).Trim(Chr(0)) 00062: End Function 00063: 00064: ''' <summary> 00065: ''' Зашифровать пароль - максимум 16 символов 00066: ''' Если второй параметр опущен, то он будет автоматически известен при расшифровке 00067: ''' </summary> 00068: ''' <param name="Pass">Шифруемая строка</param> 00069: ''' <param name="IniVector">Специально заданный модификатор ключа шифрования</param> 00070: ''' <returns>SecureBytes(32) as byte </returns> 00071: ''' <remarks>Rijndael Simmetric algoritm</remarks> 00072: Friend Shared Function SecurePass16(ByVal Pass As String, ByVal IniVector As String) As Byte() 00073: Dim Rijndael As Security.Cryptography.RijndaelManaged = CType(Security.Cryptography.RijndaelManaged.Create, Security.Cryptography.RijndaelManaged) 00074: Rijndael.BlockSize = 256 'это максимум 00075: Return Secure(Rijndael, Pass, IniVector, Rijndael.BlockSize) 00076: End Function 00077: 00078: ''' <summary> 00079: ''' Зашифровать пароль - максимум 16 символов 00080: ''' Если второй параметр опущен, то он будет автоматически известен при расшифровке 00081: ''' </summary> 00082: ''' <param name="Pass">Шифруемая строка</param> 00083: ''' <returns>SecureBytes(32) as byte</returns> 00084: ''' <remarks>Rijndael Simmetric algoritm</remarks> 00085: Friend Shared Function SecurePass16(ByVal Pass As String) As Byte() 00086: Dim Rijndael As Security.Cryptography.RijndaelManaged = CType(Security.Cryptography.RijndaelManaged.Create, Security.Cryptography.RijndaelManaged) 00087: Rijndael.BlockSize = 256 'это максимум 00088: Return Secure(Rijndael, Pass, My.Application.Info.AssemblyName & My.Application.Info.Copyright, Rijndael.BlockSize) 00089: End Function 00090: 00091: Private Shared Function Secure(ByVal Rijndael As Security.Cryptography.RijndaelManaged, ByVal Pass As String, ByVal IniVector As String, ByVal BlockSize As Integer) As Byte() 00092: If Pass.Length > Rijndael.BlockSize / 8 Then 00093: Throw New Exception("Максимальная длина пароля " & CInt(Rijndael.BlockSize / 8).ToString & " символов.") 00094: Exit Function 00095: End If 00096: ' 00097: Dim BufSize As Integer = CInt(Rijndael.BlockSize / 8) - 1 00098: ' 00099: Dim InputBuf(BufSize) As Byte 00100: Dim SecureByte(BufSize) As Byte 00101: Dim IV(BufSize) As Byte 00102: Dim Key(CInt(Rijndael.LegalKeySizes(0).MaxSize / 8) - 1) As Byte 00103: ' 00104: Dim Tmp() As Byte = GetKey(IniVector) 00105: For i As Integer = 0 To Math.Min(UBound(IV), UBound(Tmp)) 00106: IV(i) = Tmp(i) 00107: Next 00108: For i As Integer = 0 To Math.Min(UBound(Key), UBound(Tmp)) 00109: Key(i) = Tmp(i) 00110: Next 00111: ' 00112: Dim Encoder As New System.Text.UnicodeEncoding 00113: Dim Tmp1() As Byte = Encoder.GetBytes(Pass) 00114: ' 00115: If Tmp1.Length > InputBuf.Length Then 00116: Throw New Exception("Слишком длинный пароль для заданного размера блока.") 00117: End If 00118: For i As Integer = 0 To Math.Min(UBound(InputBuf), UBound(Tmp1)) 00119: InputBuf(i) = Tmp1(i) 00120: Next 00121: ' 00122: Dim Encriptor = Rijndael.CreateEncryptor(Key, IV) 00123: If Encriptor.TransformBlock(InputBuf, CInt(0), InputBuf.Length, SecureByte, CInt(0)) = 0 Then 00124: Throw New Exception("Шифрование не выполнено.") 00125: Exit Function 00126: End If 00127: Return SecureByte 00128: End Function 00129: 00130: Private Shared Function GetKey(ByVal InitString As String) As Byte() 00131: Dim EncriptKey(1000) As Byte 00132: Dim Encoding As New System.Text.ASCIIEncoding() 00133: Dim InitializeVector() As Byte = Encoding.GetBytes(InitString.Replace(" ", "")) 00134: Dim OutputStream As New IO.MemoryStream(EncriptKey) 00135: Dim KeyDeveloper As New Xml.XmlTextWriter(OutputStream, System.Text.Encoding.ASCII) 00136: 'первым шагом перекрутим заданную строку преобразованием BASE64 в байтовый массив 00137: KeyDeveloper.WriteBase64(InitializeVector, 0, InitializeVector.Length) 00138: KeyDeveloper.Close() 00139: OutputStream.Close() 00140: 'вторым шагом перекрутим полученный байтовый массив в строку 00141: 'для 28-байтного InitString "Copyright © VBNET2000" получается 64-символьная строка только из цифр "8150571191018874112905010448736856103861077479828681121776865119" для 00142: Dim Step2KeyBuilder = New System.Text.StringBuilder 00143: For i As Integer = UBound(EncriptKey) To 0 Step -1 00144: If EncriptKey(i) <> 0 Then Step2KeyBuilder.Append(EncriptKey(i)) 00145: Next 00146: Dim Step2KeyString As String = Step2KeyBuilder.ToString 00147: 'третьим шагом обращенную строку из цифр перегоним в массив байт 00148: Dim Ret(CInt((Step2KeyString.Length - 1) / 2) - 1) As Byte 00149: For i As Integer = 0 To UBound(Ret) 00150: Ret(i) = CByte(CInt(Step2KeyString.Substring(i * 2, 2))) 00151: Next 00152: Return Ret 00153: End Function 00154: 00155: #Region "Тест этого модуля с формы" 00156: 'Dim SecureByte() As Byte = Crypt.SecurePass16(TextBox1.Text) 00157: 'Dim Encoder As New System.Text.UnicodeEncoding 00158: 'TextBox2.Text = Encoder.GetString(SecureByte) 00159: 'Dim Y As New System.Text.StringBuilder 00160: 'For j As Integer = 0 To UBound(SecureByte) 00161: ' Y.Append(SecureByte(j)) 00162: 'Next 00163: 'TextBox3.Text = Y.ToString 00164: 'TextBox4.Text = Crypt.UnSecurePass16(SecureByte) 00165: #End Region 00166: End Class
Ну и далее собственно текст главной формы:
00001: Public Class Main 00002: 00003: ''' <summary> 00004: ''' Корневой каталог проекта 00005: ''' </summary> 00006: Private Sub btOpen_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btOpen.Click 00007: FolderBrowserDialog1.Description = "Выберите каталог с сайтом." 00008: FolderBrowserDialog1.ShowDialog() 00009: If FolderBrowserDialog1.SelectedPath = "" Then Exit Sub 00010: Me.Text &= FolderBrowserDialog1.SelectedPath 00011: Dim C As Cursor = Me.Cursor 00012: Me.Cursor = Cursors.WaitCursor 00013: GetDir(FolderBrowserDialog1.SelectedPath, T1.Nodes.Add(FolderBrowserDialog1.SelectedPath, FolderBrowserDialog1.SelectedPath, 0)) 00014: Me.Cursor = C 00015: btCheckLocal.Enabled = True 00016: btCheckInet.Enabled = True 00017: btSave.Enabled = True 00018: btViewLog.Enabled = True 00019: btSaveFTP.Enabled = True 00020: btSetFTP.Enabled = True 00021: End Sub 00022: 00023: ''' <summary> 00024: ''' Рекурсивная прога обхода каталога проекта 00025: ''' </summary> 00026: Private Sub GetDir(ByVal StartPath As String, ByVal StartNode As TreeNode) 00027: Dim X As New IO.DirectoryInfo(StartPath) 00028: For Each F As IO.FileInfo In X.GetFiles(txFilter.Text) 00029: StartNode.Nodes.Add(F.Name, F.Name, 1) 00030: Next 00031: For Each D As IO.DirectoryInfo In X.GetDirectories() 00032: GetDir(D.FullName, StartNode.Nodes.Add(D.Name, D.Name, 0)) 00033: Next 00034: End Sub 00035: 00036: ''' <summary> 00037: ''' каждый узел на котором кликнули мышкой становится текущим и на файлах добавляется контекстное меню 00038: ''' </summary> 00039: Private Sub T1_NodeMouseClick(ByVal sender As Object, ByVal e As Windows.Forms.TreeNodeMouseClickEventArgs) Handles T1.NodeMouseClick 00040: T1.SelectedNode = e.Node 00041: If T1.SelectedNode.ImageIndex = 1 Then 00042: T1.ContextMenuStrip = ContextMenuStrip1 00043: Else 00044: T1.ContextMenuStrip = Nothing 00045: End If 00046: 00047: End Sub 00048: 00049: ''' <summary> 00050: ''' Вывели в браузер 00051: ''' </summary> 00052: Private Sub T1_AfterSelect(ByVal sender As Object, ByVal e As Windows.Forms.TreeViewEventArgs) Handles T1.AfterSelect 00053: Dim C As Cursor = Me.Cursor 00054: Me.Cursor = Cursors.WaitCursor 00055: W1.Url = New Uri(e.Node.FullPath) 00056: Me.Cursor = C 00057: End Sub 00058: 00059: ''' <summary> 00060: ''' Проанализировали текст в браузере и заполнили тему, ключевые слова и линки на форме 00061: ''' Странно вызывается этот хандлер. Во-первых асинхронно, а во-вторых почему-то не всегда ! 00062: ''' Иногда, браузер похоже просто берет что-то из кеша и этот хандлер не вызывает. 00063: ''' </summary> 00064: Private Sub W1_DocumentCompleted(ByVal sender As Object, ByVal e As Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles W1.DocumentCompleted 00065: 'этот хандлер управляет курсором сам (автоматически) 00066: txTitle.Text = "" 00067: txKey.Text = "" 00068: DT1.Rows.Clear() 00069: If T1.SelectedNode.ImageIndex = 0 Then 00070: txTitle.Enabled = False 00071: txKey.Enabled = False 00072: G1.Enabled = False 00073: 00074: Exit Sub 00075: End If 00076: ' 00077: txTitle.Enabled = True 00078: txKey.Enabled = True 00079: G1.Enabled = True 00080: 'заполнили заголовок и выбрали ключевые слова и ссылки 00081: txTitle.Text = W1.DocumentTitle 00082: For Each X As Windows.Forms.HtmlElement In W1.Document.Links 00083: DT1.Rows.Add(False, CType(X.DomElement, mshtml.HTMLAnchorElement).href) 00084: Next 00085: For Each Y As Windows.Forms.HtmlElement In W1.Document.All 00086: If Y.TagName = "META" Then 00087: If CType(Y.DomElement, mshtml.HTMLMetaElement).httpEquiv = "Keywords" Then 00088: txKey.Text = CType(Y.DomElement, mshtml.HTMLMetaElementClass).content 00089: End If 00090: End If 00091: Next 00092: 'проанализировали текст и выбрали слова из текста 00093: DT2.Clear() 00094: Dim txBody As String = W1.Document.GetElementsByTagName("body")(0).InnerText 00095: Dim A() As String 00096: A = txBody.Replace(vbCr, "").Replace(vbLf, "").Replace(",", "").Split(CChar(" ")) 00097: Array.Sort(A) 00098: Dim B As New Collections.Generic.List(Of OneWords) 00099: Dim D As Integer = 0 00100: For i = 1 To UBound(A) 00101: If A(i).Replace(" ", "").Length > 2 Then 00102: If A(i) <> A(i - 1) Then 00103: B.Add(New OneWords(D + 1, A(i - 1).Replace(" ", ""))) 00104: D = 0 00105: Else 00106: D += 1 00107: End If 00108: End If 00109: Next 00110: For i = 0 To B.Capacity - 1 00111: DT2.Rows.Add(B(i).Num, B(i).Words) 00112: Next 00113: End Sub 00114: 00115: Friend Structure OneWords 00116: Public Sub New(ByVal a_Num As Integer, ByVal a_Words As String) 00117: Num = a_Num : Words = a_Words 00118: End Sub 00119: Dim Num As Integer 00120: Dim Words As String 00121: End Structure 00122: 00123: Dim DT1 As New DataTable 00124: Dim DT2 As New DataTable 00125: ''' <summary> 00126: ''' Таблу для линков формируем динамически 00127: ''' </summary> 00128: Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load 00129: Control.CheckForIllegalCrossThreadCalls = False 'так маршализация не валится даже под отладчиком 00130: ' 00131: DT1.Columns.Add("Check", Type.GetType("System.Boolean")) 00132: DT1.Columns.Add("Link", Type.GetType("System.String")) 00133: G1.DataSource = DT1 00134: DT1.DefaultView.Sort = "Link" 00135: G1.Columns("Check").Width = 50 00136: G1.Columns("Check").ReadOnly = True 00137: G1.Columns("Link").ReadOnly = True 00138: G1.AllowUserToAddRows = False 00139: G1.AllowUserToDeleteRows = False 00140: G1.RowHeadersVisible = False 00141: G1.SelectionMode = DataGridViewSelectionMode.FullRowSelect 00142: ' 00143: DT2.Columns.Add("Kol", Type.GetType("System.Int32")) 00144: DT2.Columns.Add("Word", Type.GetType("System.String")) 00145: G2.DataSource = DT2 00146: DT2.DefaultView.Sort = "Kol DESC" 00147: G2.Columns("Kol").Width = 50 00148: G2.Columns("Kol").ReadOnly = True 00149: G2.Columns("Word").ReadOnly = True 00150: G2.AllowUserToAddRows = False 00151: G2.AllowUserToDeleteRows = False 00152: G2.RowHeadersVisible = False 00153: G2.SelectionMode = DataGridViewSelectionMode.CellSelect 00154: G2.ContextMenuStrip = ContextMenuStrip2 00155: End Sub 00156: 00157: ''' <summary> 00158: ''' Локальные ссылки проверяются бесхитростно 00159: ''' </summary> 00160: Private Sub btCheckLocal_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btCheckLocal.Click 00161: Dim C As Cursor = Me.Cursor 00162: Me.Cursor = Cursors.WaitCursor 00163: For Each X As Data.DataRow In DT1.Rows 00164: If X("Link").ToString.StartsWith("file:///") Then 00165: If IO.File.Exists(X("Link").ToString.Replace("file:///", "")) Then 00166: X("Check") = True 00167: End If 00168: End If 00169: Next 00170: Me.Cursor = C 00171: End Sub 00172: 00173: ''' <summary> 00174: ''' Проверка сетевых ссылок - каждая в своем потоке 00175: ''' </summary> 00176: Private Sub btCheckInet_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btCheckInet.Click 00177: Dim C As Cursor = Me.Cursor 00178: Me.Cursor = Cursors.WaitCursor 00179: ErrMsg.Text = "Сайты, не ответившие в течении 10 секунд, считаются несуществующими." 00180: ProgressBar1.Visible = True 00181: Me.Refresh() 00182: 'В этой коллекции сохраним все сведения о запущенных процессах 00183: Dim ProcessList As New Collections.Generic.List(Of OneProcess) 00184: For Each X As Data.DataRow In DT1.Rows 00185: If X("Link").ToString.StartsWith("http://") Then 00186: 'Сначала запустим все процессы проверки наличия линков 00187: Dim L As New CheckLink(New Uri(X("Link").ToString), 10000) 00188: Dim P As New Threading.Thread(AddressOf L.GoLink) 00189: ProcessList.Add(New OneProcess(L, P, X)) 00190: P.Start() 00191: End If 00192: Next 00193: 'Теперь подождем их завершения 00194: For T As Integer = 0 To ProgressBar1.Step 00195: Threading.Thread.Sleep(1000) 00196: ProgressBar1.PerformStep() 00197: Me.Refresh() 00198: Next 00199: 'И теперь проставим отметки на форме 00200: For Each Z As OneProcess In ProcessList 00201: If Z.Checklink.URL_IsPresent Then Z.DataRow("Check") = True 00202: Next 00203: ProcessList.Clear() 'ссылок у нас на процесс нету, он завершится по таймауту и освободит память 00204: ProgressBar1.Visible = False 00205: ErrMsg.Text = "" 00206: Me.Cursor = C 00207: End Sub 00208: 00209: ''' <summary> 00210: ''' В этой структуре упакована вся информация об одном запущенном процессе проверки линка: 00211: ''' Процесс проверки, Экземпляр класса с запросом/ответом браузера и строка в табле, для которой выполняется проверка 00212: ''' </summary> 00213: Friend Structure OneProcess 00214: Public Process As Threading.Thread 00215: Public Checklink As CheckLink 00216: Public DataRow As Data.DataRow 00217: Public Sub New(ByVal CheckLinkClass As CheckLink, ByVal ProcessClass As Threading.Thread, ByVal DataRowClass As Data.DataRow) 00218: Process = ProcessClass 00219: Checklink = CheckLinkClass 00220: DataRow = DataRowClass 00221: End Sub 00222: End Structure 00223: 00224: ''' <summary> 00225: ''' Этот класс выполняется в своем потоке - принимает запрос на проверку линка и ждет ответ 00226: ''' Если дождется и ответ будет OK - выставит флаг URL_IsPresent=True 00227: ''' </summary> 00228: Friend Class CheckLink 00229: Dim Request1 As Net.WebRequest 00230: Dim Response1 As Net.WebResponse 00231: Public URL_IsPresent As Boolean = False 00232: Public Sub New(ByVal URL As Uri, ByVal TimeOut As Integer) 00233: Request1 = Net.WebRequest.Create(URL) 00234: Request1.Timeout = TimeOut 00235: End Sub 00236: Public Sub GoLink() 00237: Try 00238: Response1 = Request1.GetResponse 00239: Catch ex As Net.WebException 00240: Exit Sub 00241: End Try 00242: If CType(Response1, Net.HttpWebResponse).StatusCode = Net.HttpStatusCode.OK Then 00243: URL_IsPresent = True 00244: End If 00245: End Sub 00246: End Class 00247: 00248: ''' <summary> 00249: ''' Сохранили локально на диск модифицированный текст 00250: ''' </summary> 00251: Private Sub btSave_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btSave.Click 00252: 'заменили в коде браузера заголовок 00253: CType(W1.Document.DomDocument, mshtml.HTMLDocumentClass).title = txTitle.Text 00254: Dim MetaIsPresent As Boolean = False 00255: 'заменили тег с ключевыми словами 00256: For Each X As Object In CType(W1.Document.DomDocument, mshtml.HTMLDocumentClass).all 00257: If X.GetType.Name = "HTMLMetaElementClass" Then 00258: If CType(X, mshtml.HTMLMetaElement).httpEquiv = "Keywords" Then 00259: MetaIsPresent = True 00260: CType(X, mshtml.HTMLMetaElement).content = txKey.Text 00261: End If 00262: End If 00263: Next 00264: 'или добавили этот тег вновь 00265: If Not MetaIsPresent Then 00266: Dim M As mshtml.IHTMLElement = CType(W1.Document.DomDocument, mshtml.HTMLDocumentClass).createElement("meta") 00267: CType(M, mshtml.HTMLMetaElement).httpEquiv = "Keywords" 00268: CType(M, mshtml.HTMLMetaElement).content = txKey.Text 00269: 'заменили тег с ключевыми словами 00270: For Each X As Object In CType(W1.Document.DomDocument, mshtml.HTMLDocumentClass).all 00271: If X.GetType.Name = "HTMLHeadElementClass" Then 00272: Dim Header As mshtml.HTMLHeadElement = CType(X, mshtml.HTMLHeadElement) 00273: Header.insertBefore(CType(M, mshtml.IHTMLDOMNode)) 00274: Exit For 00275: End If 00276: Next 00277: End If 00278: 'и записали на диск 00279: Dim F As New IO.FileStream(W1.Url.LocalPath.ToString, IO.FileMode.Open, IO.FileAccess.Write, IO.FileShare.None) 00280: Dim HtmlString As String = CType(CType(W1.Document.DomDocument, mshtml.HTMLDocumentClass).getElementsByTagName("HTML").item(0), mshtml.HTMLHtmlElementClass).outerHTML 00281: Dim EncoderU As New System.Text.UnicodeEncoding 00282: 'строку в памяти в Unicode придется преобразовать в ANSI, ибо если просто F.Write(HtmlString) - то на диске оказывается ?????? в ANSI 00283: Dim UnicodeArray() As Byte = EncoderU.GetBytes(HtmlString) 00284: Dim ASCII_RUS() As Byte = System.Text.Encoding.Convert(System.Text.Encoding.Unicode, System.Text.Encoding.GetEncoding("windows-1251"), UnicodeArray, 0, UnicodeArray.Length) 00285: F.Write(ASCII_RUS, 0, ASCII_RUS.Length) 00286: F.Close() 00287: T1.SelectedNode.ForeColor = Color.Red 00288: 00289: 'Кодировки Слова "привет" на диске 00290: 'UTF8 - EF BB BF D0 BF D1 80 D0 B8 D9 B2 D0 B5 D1 82 00291: 'UNICODE - FF FE 3F 04 40 04 38 04 32 04 35 04 42 04 00292: 'ASCII - EF F0 E8 E2 E5 F2 00293: 'ASCII - в байтах в десятичном виде (как показывает отладчик) - 239 240 232 226 229 242 00294: ' 00295: 'Dim EncoderA As New System.Text.ASCIIEncoding 00296: 'Dim EncoderU As New System.Text.UnicodeEncoding 00297: ' 00298: 'правильный запрос на перекодировку 00299: '? System.Text.Encoding.Convert( system.Text.Encoding.Unicode,system.Text.Encoding.GetEncoding("windows-1251"), EncoderU.GetBytes("привет"),0,12) 00300: '{Length=6} 00301: ' (0): 239 00302: ' (1): 240 00303: ' (2): 232 00304: ' (3): 226 00305: ' (4): 229 00306: ' (5): 242 00307: 00308: End Sub 00309: 00310: ''' <summary> 00311: ''' На редактирование файл вызывается во внешнем редакторе (пока) 00312: ''' </summary> 00313: Private Sub cmEdit_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmEdit.Click 00314: Diagnostics.Process.Start("Notepad.exe", T1.SelectedNode.FullPath) 00315: T1.SelectedNode.ForeColor = Color.Red 00316: End Sub 00317: 00318: ''' <summary> 00319: ''' Формирование файла robot.txt 00320: ''' </summary> 00321: Private Sub cmNoRobot_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmNoRobot.Click 00322: ContextMenuStrip1.Close() 00323: Dim C As Cursor = Me.Cursor 00324: Me.Cursor = Cursors.WaitCursor 00325: Dim Disallow As New Collections.Generic.List(Of String) 00326: Disallow.Clear() 00327: If IO.File.Exists(IO.Path.Combine(FolderBrowserDialog1.SelectedPath, "robot.txt")) Then 00328: 'прочитали все имеющиеся директивы Disallow в коллекцию Disallow 00329: Dim R As New IO.StreamReader(IO.Path.Combine(FolderBrowserDialog1.SelectedPath, "robot.txt")) 00330: While Not R.EndOfStream 00331: Dim One As String = R.ReadLine 00332: If One.StartsWith("Disallow:") Then 00333: Disallow.Add(One.Replace("Disallow:", "").Replace(" ", "")) 00334: End If 00335: End While 00336: R.Close() 00337: End If 00338: 'добавили текущий неиндексируемый файл в эту коллекцию и сохранили коллекцию в файл 00339: If Not Disallow.Contains(T1.SelectedNode.FullPath.Replace(FolderBrowserDialog1.SelectedPath, "").Replace("\", "/")) Then Disallow.Add(T1.SelectedNode.FullPath.Replace(FolderBrowserDialog1.SelectedPath, "")) 00340: Dim W As New IO.StreamWriter(IO.Path.Combine(FolderBrowserDialog1.SelectedPath, "robot.txt")) 00341: W.WriteLine("User-agent: *") 00342: For Each X As String In Disallow 00343: W.WriteLine("Disallow: " & X.Replace("\", "/")) 00344: Next 00345: W.Close() 00346: Me.Cursor = C 00347: End Sub 00348: 00349: ''' <summary> 00350: ''' Вызов формы ввода логина и пароля к FTP 00351: ''' </summary> 00352: Private Sub btSetFTP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btSetFTP.Click 00353: Dim X As New LoginFTP 00354: X.ShowDialog() 00355: End Sub 00356: 00357: ''' <summary> 00358: ''' Асинхронный аплоад файла на FTP. Отметка (цветом) в дереве проекта делается по окончании сохранения 00359: ''' </summary> 00360: Private Sub btSaveFTP_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btSaveFTP.Click 00361: If T1.SelectedNode Is Nothing Then Exit Sub 00362: If T1.SelectedNode.ImageIndex <> 1 Then Exit Sub 00363: Dim C As Cursor = Me.Cursor 00364: Me.Cursor = Cursors.WaitCursor 00365: Dim X As New UploadFileToFTP_and_CheckTreeNode(Me, T1.SelectedNode.FullPath, FolderBrowserDialog1.SelectedPath, T1.SelectedNode) 00366: Dim T As New Threading.Thread(AddressOf X.GO) 00367: T.Start() 00368: Me.Cursor = C 00369: End Sub 00370: 00371: ''' <summary> 00372: ''' Сохраняем robot.txt 00373: ''' </summary> 00374: Private Sub btViewLog_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btViewLog.Click 00375: Dim C As Cursor = Me.Cursor 00376: Me.Cursor = Cursors.WaitCursor 00377: Dim X As New UploadFileToFTP_and_CheckTreeNode(Me, IO.Path.Combine(FolderBrowserDialog1.SelectedPath, "robot.txt"), FolderBrowserDialog1.SelectedPath) 00378: Dim T As New Threading.Thread(AddressOf X.GO) 00379: T.Start() 00380: Me.Cursor = C 00381: End Sub 00382: 00383: Private Sub CopyToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CopyToolStripMenuItem.Click 00384: Clipboard.SetText(G2.CurrentRow.Cells(1).Value.ToString) 00385: End Sub 00386: 00387: End Class 00388: 00389: ''' <summary> 00390: ''' Этот класс асинхронно загружает файл на FTP (вычитывая и расшифровывая пароль) 00391: ''' и при удачном завершении модифицирует форму в ее собственном потоке 00392: ''' </summary> 00393: Friend Class UploadFileToFTP_and_CheckTreeNode 00394: Dim a_LocalFileName As String 00395: Dim a_LocalRoot As String 00396: Dim a_WinForm As Windows.Forms.Form 00397: Dim a_TreeNode As TreeNode 00398: Dim ErrMessage As String 00399: Dim FTPRequest As System.Net.FtpWebRequest 00400: Dim FTPResponse As System.Net.FtpWebResponse 00401: 00402: Public ReadOnly Property Message() As String 00403: Get 00404: Message = ErrMessage 00405: End Get 00406: End Property 00407: Public ReadOnly Property Request() As Net.FtpWebRequest 00408: Get 00409: Request = FTPRequest 00410: End Get 00411: End Property 00412: Public ReadOnly Property Response() As Net.FtpWebResponse 00413: Get 00414: Response = FTPResponse 00415: End Get 00416: End Property 00417: 00418: ''' <summary> 00419: ''' Если создали экземпляр с этим конструктором - то требуется отметка в узле дерева 00420: ''' </summary> 00421: Public Sub New(ByVal WinForm As Windows.Forms.Form, ByVal LocalFileName As String, ByVal LocalRoot As String, ByVal TreeNode As TreeNode) 00422: a_LocalFileName = LocalFileName 00423: a_LocalRoot = LocalRoot 00424: a_WinForm = WinForm 00425: a_TreeNode = TreeNode 00426: End Sub 00427: 00428: ''' <summary> 00429: ''' Отметки в дереве не нужны - только сообщения об ошиках 00430: ''' </summary> 00431: Public Sub New(ByVal WinForm As Windows.Forms.Form, ByVal LocalFileName As String, ByVal LocalRoot As String) 00432: a_LocalFileName = LocalFileName 00433: a_LocalRoot = LocalRoot 00434: a_WinForm = WinForm 00435: a_TreeNode = Nothing 00436: End Sub 00437: 00438: Public Sub GO() 00439: 'прочитали загружаемый файл 00440: Dim Local As New IO.StreamReader(a_LocalFileName) 00441: Dim LocalHTMLstr As String = Local.ReadToEnd 00442: Local.Close() 00443: Dim Encoder As New System.Text.ASCIIEncoding 00444: Dim LocalHTML() As Byte = Encoder.GetBytes(LocalHTMLstr) 00445: LocalHTMLstr = Nothing 00446: 'и пытаемся загрузить его 00447: Dim FTP_Server As String 00448: Dim FTP_Login As String 00449: Dim FTP_Password As String 00450: Dim FTP_Timeout As Integer 00451: Using LM As Microsoft.Win32.RegistryKey = My.Computer.Registry.LocalMachine.OpenSubKey("SOFTWARE", True) 00452: Using VBN As Microsoft.Win32.RegistryKey = LM.OpenSubKey("VBNET2000") 00453: If VBN Is Nothing Then 00454: ErrMessage = "Не установлены логин и пароль для доступа на FTP-сервер" 00455: Dim UpdateWindowsFormDelegate As System.Windows.Forms.MethodInvoker = New System.Windows.Forms.MethodInvoker(AddressOf ModifyWindowsFormErr) 00456: UpdateWindowsFormDelegate.Invoke() 00457: Exit Sub 00458: End If 00459: FTP_Server = CStr(VBN.GetValue("FTP_Server", "")) 00460: FTP_Login = CStr(VBN.GetValue("FTP_Login", "")) 00461: FTP_Timeout = CInt(VBN.GetValue("FTP_Timeout", "")) 00462: FTP_Password = Crypt.UnSecurePass16(CType(VBN.GetValue("FTP_Password"), Byte())) 00463: End Using 00464: End Using 00465: 'пароли прочитались - формируем FTP-запрос 00466: Try 00467: FTPRequest = CType(System.Net.FtpWebRequest.Create("ftp://" & FTP_Server & a_LocalFileName.Replace(a_LocalRoot, "").Replace("\", "/")), System.Net.FtpWebRequest) 00468: FTPRequest.UsePassive = True 00469: FTPRequest.Timeout = FTP_Timeout * 1000 00470: FTPRequest.Credentials = New Net.NetworkCredential(FTP_Login, FTP_Password) 00471: FTPRequest.Method = System.Net.WebRequestMethods.Ftp.UploadFile 00472: Dim UploadStream As IO.Stream = FTPRequest.GetRequestStream 00473: UploadStream.Write(LocalHTML, 0, LocalHTML.Length) 00474: UploadStream.Close() 00475: Catch ex As Exception 00476: 'нескладушки с запросом 00477: ErrMessage = ex.Message 00478: Dim UpdateWindowsFormDelegate As System.Windows.Forms.MethodInvoker = New System.Windows.Forms.MethodInvoker(AddressOf ModifyWindowsFormErr) 00479: UpdateWindowsFormDelegate.Invoke() 00480: Exit Sub 00481: End Try 00482: 'запрос сформирован нормально - ждем ответ 00483: Try 00484: FTPResponse = CType(FTPRequest.GetResponse, Net.FtpWebResponse) 00485: Catch ex As Exception 00486: 'нескладушки с ответом 00487: ErrMessage = ex.Message 00488: Dim UpdateWindowsFormDelegate As System.Windows.Forms.MethodInvoker = New System.Windows.Forms.MethodInvoker(AddressOf ModifyWindowsFormErr) 00489: UpdateWindowsFormDelegate.Invoke() 00490: End Try 00491: If FTPResponse.StatusCode = Net.FtpStatusCode.ClosingData Then 00492: 'маршализация в поток формы 00493: If a_TreeNode IsNot Nothing Then 00494: 'с отметкой в дереве 00495: Dim UpdateWindowsFormDelegate As System.Windows.Forms.MethodInvoker = New System.Windows.Forms.MethodInvoker(AddressOf ModifyWindowsFormOK) 00496: UpdateWindowsFormDelegate.Invoke() 00497: Else 00498: 'только погашение сообщений об ошибках 00499: Dim UpdateWindowsFormDelegate As System.Windows.Forms.MethodInvoker = New System.Windows.Forms.MethodInvoker(AddressOf ModifyWindowsFormErr) 00500: UpdateWindowsFormDelegate.Invoke() 00501: End If 00502: Else 00503: ErrMessage = "URL=" & FTP_Server & vbCrLf & _ 00504: "PageResponse.StatusCode=" & FTPResponse.StatusCode.ToString & vbCrLf & _ 00505: "StatusDescription=" & FTPResponse.StatusDescription.ToString & vbCrLf & _ 00506: "WelcomeMessage=" & FTPResponse.WelcomeMessage.ToString & vbCrLf & _ 00507: "BannerMessage=" & FTPResponse.BannerMessage.ToString 00508: Dim UpdateWindowsFormDelegate As System.Windows.Forms.MethodInvoker = New System.Windows.Forms.MethodInvoker(AddressOf ModifyWindowsFormErr) 00509: UpdateWindowsFormDelegate.Invoke() 00510: End If 00511: End Sub 00512: 00513: 'эти методы выполнятся уже в потоке формы 00514: Private Sub ModifyWindowsFormOK() 00515: a_TreeNode.ForeColor = Color.Black 00516: CType(a_WinForm, Global.SiteChecker.Main).ErrMsg.Text = "" 00517: End Sub 00518: 00519: Private Sub ModifyWindowsFormErr() 00520: CType(a_WinForm, Global.SiteChecker.Main).ErrMsg.Text = ErrMessage 00521: End Sub 00522: End Class
При просмотре текста проги обратите внимание на следующие пару моментов :
- Кодировку (Unicode-строки из памяти на диск сохраняются в ANSI)
- Мультипоточное программирование и маршализацию в поток формы - тут все сделано с асинхронной маршализацией.
- Обратите ввнимение на класс аплоада на FTP с асинхронным обновлением формы. Класс достаточно интеллектуальный, обращается к вышеприведенному криптографическому модулю.
- Обратите внимание, что я выбрал путь асинхронизма не BeginInvoke, а Threading.Start - хотя отвергнутый мною путь тоже имеет право на существование. Это просто привычка...
- Я не стал убивать запущенные и зависшие процессы проверки ссылок, надеясь на сборку мусора. Хотя можно было бы сделать и по-другому.
- Обратите внимание, что все разборки HTML делаются только в обьектной модели и никаких строк!
- Обратите внимение на динамически формируемые DataTable и привязку DataGridView к ним не в статике (как обычно), а при загрузке формы.
- В принципе я бы мог расширить прогу на прямую запись откорректированных линков в DataGridView, но просто уже не хватало времени на рефакторинг этой проги.
- Ну я здесь не упоминал самые тривиальные вещи (как мне кажется) рекурсивное заполнение дерева и работу с ним - хотя кому-то даже эти вещи могут показаться интересными... Ну или например, работа с дженериками...
Наиболее интересная техника, которую я не успел реализовать в этой проге из-за недостатка времени - заключается в вызове прямо внутри контрола браузера его встроенных форм Find, Print и тд. Эта техника описана здесь.
Comments (
)
)
Link to this page:
//www.vb-net.com/windows/SiteChecker/index.htm
|
|