what's new
1) now you first select platform and after that the game name (that makes more sense
 )
)BUT if you want you can have a default platform (that is you don't have to select it first). To do that, you have to edit the script and change the constant dfltPlatform = '' to dfltPlatform = 'name_of_the_platform_know-by_allgame'
2) batch mode: edit the script and change BatchMode = False to BatchMode = True
to use that mode, you must have a database created with this script (with at least the url field filled). Don't forget to save your database before using that and work only with few games at a time
[en français pour ceux qui entravent quedalle à l'anglais]
quoi'd'neuf
1) on selectionne maintenant en 1er la console puis le nom du jeu (c'est plus logique non
 ).
). MAIS si vous le voulez, vous pouvez imposer une console par défaut. Pour cela, éditer le script et changez la constante dfltPlatform = '' en dfltPlatform = 'nom_de_la_console_connue_par_allgame'
2) mode batch: editez le script et changez BatchMode = False en BatchMode = True
pour utiliser ce mode, vous devez avoir une base créée avec ce script (avec au moins le champ adresse web valorisé). N'oubliez pas de sauvegarder votre base avant d'utiliser ce mode et travaillez avec seulement quelques jeux à la fois
Code: Select all
// GETINFO SCRIPTING
// AllGame
(***************************************************
 *  importation script for:                        *
 *  AllGame http://www.allgame.com                 *
 *  version 1.4 (c) 2004 scorpion7552              *
 *                                                 *
 *  For use with Ant Movie Catalog 3.4.3           *
 *  www.ant.be.tf/moviecatalog ··· www.buypin.com  *
 *                                                 *
 *  The source code of the script can be used in   *
 *  another program only if full credits to        *
 *  script author and a link to Ant Movie Catalog  *
 *  website are given in the About box or in       *
 *  the documentation of the program               *
 ***************************************************)
program AllGame;
const
{ExternalPictures 
	True: Les images seront stockées en tant que fichiers dans le même dossier que le catalogue
	False: Les images seront stockées dans le catalogue (seulement pour les fichiers .amc)
} 
	ExternalPictures = False;
{ Always2
	False: write fields only if not empty 
	True: write fields even if empty
}
	Always2 = False;
{ BatchMode
	False: normal mode
	True: batchmode: You must have a database made with AllGame 
				with at least url field initialized 
}
	BatchMode = False;
{ dfltPlatform
	name of platform by default; if = '' then select one manually
	must be the real name known by allgame
	for PC, enter 'IBM PC Compatible'
}
	dfltPlatform = '';
//
	AllGameUrl = 'http://www.allgame.com';    // base url
	crlf = #13#10;
	sepchar = #2;                             // internal separator
// debug mode
	debug = False;                            // debug mode on/off
	debugrep = 'd:\temp\';                   // directory where to save files
var
	GameName, EndStr, platformc: String;
	Always, gameok: Boolean;
	
//------------------------------------------------------------------------------
// get platform id
// on output, platformc = name of selected platform 
//------------------------------------------------------------------------------
procedure GetPlatform();   
var
	Page, Line, Table, msg, urlplatform: string; 
begin
	msg := 'Enter platform name';
	repeat
// enter platform name; leave script if nothing entered
	if (not Input('AllGame.com Import', msg+' :', platformc)) or (platformc = '') then
	begin
		ShowMessage('no platform selected');
		exit;
	end;
// look if there is something matching platformc
	Page := PostPage(AllGameUrl+'/cg/agg.dll', 'SRCH='+platformc+'&P=agg&TYPE=5');
	if debug then
		DumpPage(debugrep+'SelPlatformAllGame.txt', Page);    // debug
	if Pos('Game Platforms Matching', Page) = 0 then
	begin
		ShowMessage('Error while reading platform page');  
		exit;                         // leave script if big error
	end;
// selection table
	Table := ExtrStr(Page, '<TABLE BORDER=0 WIDTH=300 CELLPADDING=1 CELLSPACING=1>', '</TABLE>');
	if Table = '' then
		msg := 'No platform found for "' + platformc + '"'  // iterate
	else
	begin
// extract matching platform names (displayed on a single page)
		PickTreeClear;                                     // clear list
		PickTreeAdd('Select platform', '');
		urlplatform := 'HREF=/cg/agg.dll';                 // url to search 
		repeat                                            // list of games 
		Line := ExtrStr(Table, '<TR', '</TR>');            // extract current line
		Table := EndStr;                                   // next lines
		if GetUrl(Line, urlplatform, AllGameUrl) <> '' then    // if no url, it is the header
		begin
			Line := ExtrStr(Line, urlplatform, '');          // extract infos
			Line := FormatText(ExtrStr(Line, '>', '</A>'));  // platform name
 			PickTreeAdd(Line, Line);
		end;
		until Table = '';                                 // end repeat extract infos
		if not PickTreeExec(platformc) then
			msg := 'No platform selected';                  // iterate if no platform selected
	end;
	until platformc <> '';
end;
//------------------------------------------------------------------------------
// list of games running on platformc
//------------------------------------------------------------------------------
procedure GetList(id: string);   
var
	Address, Table, Line, Value, Page, urlgame, name, genre: String;
	memo: TStringList;
	i: Integer;
begin
	memo := TStringList.Create;                        // init memo list
	gameok := False;
	Page := PostPage(AllGameUrl+'/cg/agg.dll', 'SRCH='+id+'&P=agg&TYPE=1');
	if debug then
		DumpPage(debugrep+'choiceAllGame.txt', Page);    // debug
	if Pos('Games with Titles Matching', Page) = 0 then
	begin
		ShowMessage('Error while reading selection page');
		exit;
	end;
	if Pos('No matches found', Page) > 0 then
	begin
		ShowMessage('No game found at all for "' + GameName + '"');
		exit;
	end;
// selection table
	Table := ExtrStr(Page, '<TABLE BORDER=0 WIDTH=610 CELLPADDING=1 CELLSPACING=1>', '</TABLE>');
// note: the games are displayed on one page and are sorted by relevance
// first round: memorize games for platformc
	urlgame := 'HREF=/cg/agg.dll';                 // url to search (first occurence)
	repeat                                        // list of games 
	Line := ExtrStr(Table, '<TR', '</TR>');        // extract current line
	Table := EndStr;                               // next lines
	Address := GetUrl(Line, urlgame, AllGameUrl);  // get url of game page
	if Address <> '' then                         // if '', it is the header
	begin
		Line := ExtrStr(Line, urlgame, '');          // extract infos
		Line := ExtrStr(Line, '>', '<IMG');
		Line := StringReplace(Line, crlf, '');
		Line := StringReplace(Line, '</TD>', sepchar);   
		name := FormatText(ExtrStr(Line, '', sepchar));            // name of the game
		Line := EndStr;
		genre := FormatText(ExtrStr(Line, sepchar, sepchar));      // genre
		Line := EndStr;                                
		Line := ExtrStr(Line, sepchar, sepchar); 
		Line := EndStr;                                            // skip style
		Value := FormatText(ExtrStr(Line, sepchar, sepchar));      // Platform 
		if Copy(Value, 1, 2) = 'PC' then            // PC, PC DOS Win95, etc...
			value := 'IBM PC Compatible';             
		if Value = platformc then
		begin                                      
// current game runs on selected platform
			gameok := True;                            // game(s) found
			memo.Add(name+' ('+genre+')'+sepchar+Address);
		end;
	end;
	until Table = '';                             // end repeat
	if not gameok then
	begin
		ShowMessage('No game found for "' + GameName + '" running on "'+platformc+'"');
		exit;
	end;
	SortList(memo);                                // sort games list
// second round: select games for the choosen platform (Platformc)
	PickTreeClear;                                 // clear list
	PickTreeAdd('List of games (platform='+Platformc+')', '');
	for i:= 0 to memo.count -1 do
	begin
		Line := memo.GetString(i);
		Value := ExtrStr(Line, '', sepchar);         // name (genre)              
		Address := ExtrStr(EndStr, sepchar, '');     // url of game page
    PickTreeAdd(Value, Address);
	end;
	gameok := False;                               // back to false until selection 
	if PickTreeExec(Address) then
	begin
		SetField(fieldURL, Address);
		AnalyzeGamePage(Address);                    // game page
	end else
		ShowMessage('No game selected');
	memo.Free;
end;
//------------------------------------------------------------------------------
// ANALYZE GAME PAGE
//------------------------------------------------------------------------------
procedure AnalyzeGamePage(Address: string);
var
	Fullpage, Line, Table, Value, Value2, screenshot, cover: String;
	i: Integer;
begin
	Fullpage := GetPage(Address);         
	if debug then
		DumpPage(debugrep+'gameAllGame.txt', Fullpage);    // debug
	if Pos('Release', Fullpage) = 0 then
	Begin
		ShowMessage('Error while reading game page');
		exit;
	end;
	gameok := True;                                 // now, it's ok
//*** title (original only) and rating
	Table := ExtrStr(FullPage, '<TABLE BORDER=0 BGCOLOR=#D8D8D8', '</TABLE>');
	if Table <> '' then
	begin
	  Value := ExtrStr(Table, '<B>', '</B>');
		SetField(fieldOriginalTitle, FormatText(Value));
		SetField(fieldTranslatedTitle, ''); 
	end;
	Value := ExtrStr(FullPage, '<IMG SRC="/im/agg/st_pt', '.jpg"');  // rating  (<IMG SRC="/im/agg/st_ptX.jpg"  with X = rating)
	if (Value <> '') or (Always) then            
		SetField(fieldRating, Value);
//*** platform (= country), genre (= category) and style (no field for that or may be mixed with genre ???)
	Table := ExtrStr(FullPage, '<TABLE BORDER=0 BORDERCOLOR="WHITE"', '</TABLE>');
	if Table <> '' then
	begin
		Table := StringReplace('<'+Table, '</TR>', sepchar);
		Table := StringReplace(Table, crlf, '');
		Table := FormatText(Table);
		Value := ExtrStr(Table, '', sepchar);        // platform
		Table := EndStr;
		if (Value <> '') or (Always) then
			Setfield(fieldCountry, FormatText(Value));
		Value := ExtrStr(Table, sepchar, sepchar);   // genre
		Table := EndStr;
		if (Value <> '') or (Always) then
			Setfield(fieldCategory, FormatText(Value));
	end;
// get 1st screenshot if any
	Table := ExtrStr(FullPage, '<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=0>', '</TABLE>');
	if Table <> '' then
		screenshot := GetUrl(Table, '', '');
//*** release date (year only)  ('month year' 'month day, year' or 'year')
	Table := ExtrStr(FullPage, '<TABLE WIDTH=610 BORDER=0 CELLPADDING=1 CELLSPACING=1>', '');  // multi-tables
	Value := ExtrStr(Table,'Release', '</TR>');
	Value := FormatText(Value);
// prov 3.5 voir LastPos
	i := Pos(',', Value);
	if i <> 0 then
		Value := Copy(Value, i+1, length(Value));   // month day,
	i := Pos(' ', Value); 
	if i <> 0 then 
		Value := Copy(Value, i+1, length(Value));   // month year
	if (Value <> '') or (Always) then
		SetField(fieldYear, Value);
// developper (= director)
	Value := ExtrStr(Table,'Developer', '</TR>');
	Value := FormatText(Value);
	if (Value <> '') or (Always) then
		SetField(fieldDirector, Value);
// publisher (= producer)
	Value := ExtrStr(Table,'Publisher', '</TR>');
	Value := FormatText(Value);
	if (Value <> '') or (Always) then
		SetField(fieldProducer, Value);
// various infos (= comments) controls, hardware supported, etc...
	Value2 := '';
	Value2 := Value2+ExtrInfo(Table,'Controls');
	Value2 := Value2+ExtrInfo(Table,'Warnings');
	Value2 := Value2+ExtrInfo(Table,'Flags');
	Value2 := Value2+ExtrInfo(Table,'Hardware Supported');
	Value2 := Value2+ExtrInfo(Table,'Supports');
	Value2 := Value2+ExtrInfo(Table,'Included in Package');
	Value2 := Value2+ExtrInfo(Table,'Similar Games');
	Value2 := FormatText(Value2);
	if (Value2 <> '') or (Always) then
		SetField(fieldComments, Value2);
//*** description and image
	Value := ExtrStr(FullPage, '<TABLE border=0 BGCOLOR="#D8D8D8"', '</TABLE>');
	Table := EndStr;
	if Value <> '' then
	begin
		Value := '<'+Value;
		cover := ExtrStr(Value, '<IMG SRC="', '"');        // cover url 
		Value := FormatText(Value);
		Value2 := ExtrStr(Table, '<TABLE border=0 BGCOLOR="#D8D8D8"', '</TABLE>');
		if Value2 <> '' then
		begin                                             // another description
			Value2 := FormatText('<'+Value2);
			Value := Value+crlf+Value2;
		end;
	end;
	if (Value <> '') or (Always) then
		SetField(fieldDescription, Value);
	if cover = '' then
		cover := screenshot;          // no cover: get 1st screenshot if any
	if cover <> '' then
		GetPicture(cover, ExternalPictures);
end;
//------------------------------------------------------------------------------
// extract 'various infos'
//------------------------------------------------------------------------------
function ExtrInfo(str1, str2: string) :string;
begin
	str1 := ExtrStr(str1, str2, '</TR>');
	str1 := FormatText(str1);
	if str1 <> '' then
		str1 := crlf+str2+': '+str1;
	result := str1;
end;
//------------------------------------------------------------------------------
// format a text for display
// suppress html tags, replacement of strange characters
//------------------------------------------------------------------------------
function FormatText(str1: string) :string;
var
	s: String;
 
begin
// ugly characters
	str1 := StringReplace(str1, '—', '---');
// special characters
	str1 := StringReplace(str1, '&', '&');
	str1 := StringReplace(str1, '<', '<');
	str1 := StringReplace(str1, '>', '>');
	str1 := StringReplace(str1, '"', '"');
// paragraphs = crlf
	str1 := StringReplace(str1, '</p>', crlf); 
	str1 := StringReplace(str1, '<p>', crlf);
	HTMLRemoveTags(str1);                     // suppress HTML tags
	HTMLDecode(str1);                         // and special characters
// suppress formatting characters at the begining of string (ASCII code <= x'20')
	repeat
	s := Copy(str1, 1, 1);                   // 1st character of str1
	if s <= #32 then
		Delete(str1, 1, 1);                    // out
	until (s = '') or (s > #32);
	result := Trim(str1);
end;
//------------------------------------------------------------------------------
// extract url contained in a string without edition
// addr := GetUrl(string, start_from,base_url);
//------------------------------------------------------------------------------
function GetUrl(WholeText, StartFrom, urlb: string) :string;
var
	i: Integer;
	delim: String;
begin
	result := '';
	if StartFrom <> '' then                        // if StartFrom = '', start from begining of string
	begin
		i := Pos(StartFrom, WholeText); 
		if i = 0 then                                // StartFrom not found
			exit;
		Delete(WholeText,1, i -1);                    // delete characters before StartFrom
	end; 
	i := Pos('HREF=', UpperCase(WholeText));        // start of url: href= 
	if i = 0 then                                  // no href= found
		exit;
	Delete(WholeText,1, i +4);                      // skip href=
	WholeText := ExtrStr(WholeText, '', '>');       // stop at the end of tag
	delim := Copy(WholeText, 1, 1);                 // delimiter = " or ' or nothing
	if (delim = '''') or (delim = '"') then
		Delete(WholeText, 1, 1)                       // skip ' or " 
	else
		delim := ' ';                                  // no delimiter: stop at first blank if any
	i := Pos(delim, WholeText); 
	if i > 0 then
		Delete(WholeText,i, Length(WholeText));
	WholeText := StringReplace(WholeText, '&', '&');
	WholeText := StringReplace(WholeText, '../', '');    // cf relative address
	WholeText := StringReplace(WholeText, './', '');     
	WholeText := urlb + WholeText;                       // add base url if any 
	result := Trim(WholeText);
end;
//------------------------------------------------------------------------------
// extract the string delimited by strfrom and strto in str1
// output: global variable EndStr = end of the string starting at strto
//------------------------------------------------------------------------------
function ExtrStr(str1,strfrom,strto: string) :string;
var
	i: Integer;
begin
	EndStr := '';
	if strfrom <> '' then                         // if from = '', start from begining
	begin
		i := Pos(strfrom, str1);
		if i = 0 then                               // from not found
		begin
			result := '';
			exit;
		end; 
		Delete(str1, 1, i + Length(strfrom) -1);
	end; 
	i := Pos(strto, str1);                         // end of the string
	EndStr := Copy(str1, i, Length(str1));
	Delete(str1, i, Length(str1));
	result := Trim(str1);
end;
   
//------------------------------------------------------------------------------
// sort a StringList (must be initialized)
//------------------------------------------------------------------------------
procedure SortList(stringl: TStringList);
var
	i1, i2, imin: Integer;
	min, min2: String;
 
begin
	for i1 := 0 to stringl.count -2 do
	begin
		min := stringl.GetString(i1);          // current = min
		imin := i1;
// search in next the smallest entry
		for i2 := i1 +1 to stringl.count-1 do
		begin
			min2 := stringl.GetString(i2);
			if min2 < min then 
			begin                         // current (i2) = new min
				min := min2;                 // memorize it and continue
				imin := i2;
			end;
		end;
		if imin <> i1 then
		begin                           // swap current (i1) and new min (imin)
			min2 := stringl.GetString(imin);
			stringl.SetString(imin,stringl.GetString(i1));
			stringl.SetString(i1,min2);
		end;
	end;
end;
//------------------------------------------------------------------------------
// dump a string to disk (debug mode)
// DumpPage(path_of_the_file,string)
// path_of_the_file = complete path ex: 'c:\temp\myfile.txt'
//------------------------------------------------------------------------------
procedure DumpPage(fic, str1: string);
var
	Page2: TStringList;
 
begin
	page2 := TStringList.Create;
	page2.Text := str1;
	page2.SaveToFile(fic);
	page2.Free;
end;
//------------------------------------------------------------------------------
//  start here
//------------------------------------------------------------------------------                                               
begin
	if CheckVersion(3,4,3) then
	begin
		Always := Always2;
		if BatchMode then
		begin
// batch mode : always write fields
			Always := True;
			GameName := GetField(fieldUrl);    // if no url or another site then ignore
			if (GameName <> '') and (Pos(AllGameUrl, GameName) > 0) then
				AnalyzeGamePage(GameName);
		end else
		begin
// normal mode
			platformc := dfltPlatform;
			if platformc = '' then
				GetPlatform();                              // if no default, select platform
			if platformc <> '' then
			begin
				GameName := GetField(fieldOriginalTitle);     // then game name
				if GameName = '' then
					GameName := GetField(fieldTranslatedTitle); // normally, it's not there
				if (Input('AllGame.com Import', 'Enter game name for platform "'+platformc+'" :', GameName)) and (GameName <> '') then
				begin
					GetList(UrlEncode(GameName));
					if gameok then
						DisplayResults;
				end;
			end;
		end;
	end else
		ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.4.3)');
end.

 
   
 
 )
 ) )
 )